From 5871639bb1544171310fa5c4da7196eeea2c8089 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 22 Sep 2021 12:27:41 +0200 Subject: download: Fall back to web.archive.org as a very last resort. Suggested by Florian Pelz . * guix/build/download.scm (internet-archive-uri): New procedure. (url-fetch): Append it to the list of URIs after CONTENT-ADDRESSED-URIS. --- guix/build/download.scm | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index c8ddadfdd4..1ed623034b 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -678,6 +678,18 @@ (define (resolve addresses output) (false-if-exception* (disarchive-assemble spec file #:resolver resolve)))))))) +(define (internet-archive-uri uri) + "Return a URI corresponding to an Internet Archive backup of URI, or #f if +URI does not denote a Web URI." + (and (memq (uri-scheme uri) '(http https)) + (let* ((now (time-utc->date (current-time time-utc))) + (date (date->string now "~Y~m~d~H~M~S"))) + ;; Note: the date in the URL can be anything and web.archive.org + ;; automatically redirects to the closest date. + (build-uri 'https #:host "web.archive.org" + #:path (string-append "/web/" date "/" + (uri->string uri)))))) + (define* (url-fetch url file #:key (timeout 10) (verify-certificate? #t) @@ -769,7 +781,12 @@ (define disarchive-uris (setvbuf (current-error-port) 'line) - (let try ((uri (append uri content-addressed-uris))) + (let try ((uri (append uri content-addressed-uris + (match uri + ((first . _) + (or (and=> (internet-archive-uri first) list) + '())) + (() '()))))) (match uri ((uri tail ...) (or (fetch uri file) -- cgit v1.2.3 From 348f0c61efc0f35aedcd0e44bc9fa7bf7f067942 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Sun, 12 Sep 2021 18:07:54 +0200 Subject: syscalls: Deduplicate device number conversion. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/cpio.scm (device-number, device->major+minor): Move to, and subsequently import from, … * guix/build/syscalls.scm (device-number, device-number->major+minor): …here. Note the slight name change. (mounts): Replace 16-bit open code with a DEVICE-NUMBER call. * gnu/build/linux-boot.scm (device-number): Remove duplicate 16-bit implementation in favour of the one above. (resume-if-hibernated): Reuse DEVICE-NUMBER->MAJOR+MINOR. --- gnu/build/linux-boot.scm | 18 ++++-------------- guix/build/syscalls.scm | 29 ++++++++++++++++++++++++++++- guix/cpio.scm | 21 ++++----------------- 3 files changed, 36 insertions(+), 32 deletions(-) (limited to 'guix/build') diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index 8f0f3eb2fc..8efe6e5f9c 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -25,6 +25,7 @@ (define-module (gnu build linux-boot) #:autoload (system repl repl) (start-repl) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) @@ -44,7 +45,6 @@ (define-module (gnu build linux-boot) make-static-device-nodes configure-qemu-networking - device-number boot-system)) ;;; Commentary: @@ -134,14 +134,9 @@ (define (string->major:minor string) ;; is found on the command line; our canonicalize-device-spec gives ;; up after 20 seconds. We could emulate the former by looping… (device (canonicalize-device-spec spec)) - (rdev (stat:rdev (stat device))) - ;; For backwards compatibility, device numbering is a baroque affair. - ;; This is the full 64-bit scheme used by glibc's . - (major (logior (ash (logand #x00000000000fff00 rdev) -8) - (ash (logand #xfffff00000000000 rdev) -32))) - (minor (logior (logand #x00000000000000ff rdev) - (ash (logand #x00000ffffff00000 rdev) -12)))) - (format #f "~a:~a" major minor))) + (rdev (stat:rdev (stat device)))) + (let-values (((major minor) (device-number->major+minor rdev))) + (format #f "~a:~a" major minor)))) ;; Write the resume DEVICE to this magic file, using the MAJOR:MINOR device ;; numbers if possible. The kernel will immediately try to resume from it. @@ -392,11 +387,6 @@ (define* (configure-qemu-networking #:optional (interface "eth0")) (logand (network-interface-flags sock interface) IFF_UP))) -(define (device-number major minor) - "Return the device number for the device with MAJOR and MINOR, for use as -the last argument of `mknod'." - (+ (* major 256) minor)) - (define (pidof program) "Return the PID of the first presumed instance of PROGRAM." (let ((program (basename program))) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index ac1b0c2eea..99a3b45004 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2020 Julien Lepiller ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2021 Chris Marusich +;;; Copyright © 2021 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. ;;; @@ -56,6 +57,9 @@ (define-module (guix build syscalls) restart-on-EINTR + device-number + device-number->major+minor + mount? mount-device-number mount-source @@ -448,6 +452,29 @@ (define-as-needed proc (lambda* (args ...) body ...))) (module-define! (current-module) 'variable value) (module-export! (current-module) '(variable))))))) + +;;; +;;; Block devices. +;;; + +;; Convert between major:minor pairs and packed ‘device number’ representation. +;; XXX These aren't syscalls, but if you squint very hard they are part of the +;; FFI or however you want to justify me not finding a better fit… :-) +(define (device-number major minor) ; see glibc's + "Return the device number for the device with MAJOR and MINOR, for use as +the last argument of `mknod'." + (logior (ash (logand #x00000fff major) 8) + (ash (logand #xfffff000 major) 32) + (logand #x000000ff minor) + (ash (logand #xffffff00 minor) 12))) + +(define (device-number->major+minor device) ; see glibc's + "Return two values: the major and minor device numbers that make up DEVICE." + (values (logior (ash (logand #x00000000000fff00 device) -8) + (ash (logand #xfffff00000000000 device) -32)) + (logior (logand #x00000000000000ff device) + (ash (logand #x00000ffffff00000 device) -12)))) + ;;; ;;; File systems. @@ -628,7 +655,7 @@ (define (mounts) (define (string->device-number str) (match (string-split str #\:) (((= string->number major) (= string->number minor)) - (+ (* major 256) minor)))) + (device-number major minor)))) (call-with-input-file "/proc/self/mountinfo" (lambda (port) diff --git a/guix/cpio.scm b/guix/cpio.scm index 8038a11f3c..d4a7d5f1e0 100644 --- a/guix/cpio.scm +++ b/guix/cpio.scm @@ -18,6 +18,8 @@ ;;; along with GNU Guix. If not, see . (define-module (guix cpio) + #:use-module ((guix build syscalls) #:select (device-number + device-number->major+minor)) #:use-module ((guix build utils) #:select (dump-port)) #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) @@ -129,8 +131,8 @@ (define* (make-cpio-header #:key (nlink 1) (mtime 0) (size 0) (dev 0) (rdev 0) (name-size 0)) "Return a new cpio file header." - (let-values (((major minor) (device->major+minor dev)) - ((rmajor rminor) (device->major+minor rdev))) + (let-values (((major minor) (device-number->major+minor dev)) + ((rmajor rminor) (device-number->major+minor rdev))) (%make-cpio-header MAGIC inode mode uid gid nlink mtime @@ -154,21 +156,6 @@ (define (mode->type mode) (else (error "unsupported file type" mode))))) -(define (device-number major minor) ; see glibc's - "Return the device number for the device with MAJOR and MINOR, for use as -the last argument of `mknod'." - (logior (ash (logand #x00000fff major) 8) - (ash (logand #xfffff000 major) 32) - (logand #x000000ff minor) - (ash (logand #xffffff00 minor) 12))) - -(define (device->major+minor device) ; see glibc's - "Return two values: the major and minor device numbers that make up DEVICE." - (values (logior (ash (logand #x00000000000fff00 device) -8) - (ash (logand #xfffff00000000000 device) -32)) - (logior (logand #x00000000000000ff device) - (ash (logand #x00000ffffff00000 device) -12)))) - (define* (file->cpio-header file #:optional (file-name file) #:key (stat lstat)) "Return a cpio header corresponding to the info returned by STAT for FILE, -- cgit v1.2.3 From 719bbcc15e2216b59bde34f297b92ceb9d349ce0 Mon Sep 17 00:00:00 2001 From: Liliana Marie Prikler Date: Sat, 25 Sep 2021 09:27:02 +0200 Subject: Update copyright assignments for Liliana Marie Prikler. * doc/guix.texi: Update copyright name for Liliana Marie Prikler. * gnu/packages/build-tools.scm: Update copyright name and email for Liliana Marie Prikler. * gnu/packages/convmv.scm: Likewise. * gnu/packages/emacs-xyz.scm: Likewise. * gnu/packages/emacs.scm: Likewise. * gnu/packages/esolangs.scm: Likewise. * gnu/packages/game-development.scm: Likewise. * gnu/packages/games.scm: Likewise. * gnu/packages/gnome-xyz.scm: Likewise. * gnu/packages/gnome.scm: Likewise. * gnu/packages/gstreamer.scm: Likewise. * gnu/packages/guile-xyz.scm: Likewise. * gnu/packages/minetest.scm: Likewise. * gnu/packages/music.scm: Likewise. * gnu/packages/patches/minetest-add-MINETEST_MOD_PATH.patch: Likewise. * gnu/packages/patches/ppsspp-disable-upgrade-and-gold.patch: Likewise. * gnu/packages/patches/webkitgtk-bind-all-fonts.patch: Likewise. * gnu/packages/python-xyz.scm: Likewise. * gnu/packages/unicode.scm: Likewise. * gnu/packages/xorg.scm: Likewise. * gnu/services/sound.scm: Likewise. * guix/build-system/renpy.scm: Likewise. * guix/build/emacs-utils.scm: Likewise. * guix/build/renpy-build-system.scm: Likewise. --- doc/guix.texi | 2 +- gnu/packages/build-tools.scm | 2 +- gnu/packages/convmv.scm | 2 +- gnu/packages/emacs-xyz.scm | 2 +- gnu/packages/emacs.scm | 2 +- gnu/packages/esolangs.scm | 2 +- gnu/packages/game-development.scm | 2 +- gnu/packages/games.scm | 2 +- gnu/packages/gnome-xyz.scm | 2 +- gnu/packages/gnome.scm | 2 +- gnu/packages/gstreamer.scm | 2 +- gnu/packages/guile-xyz.scm | 2 +- gnu/packages/minetest.scm | 2 +- gnu/packages/music.scm | 2 +- gnu/packages/patches/minetest-add-MINETEST_MOD_PATH.patch | 2 +- gnu/packages/patches/ppsspp-disable-upgrade-and-gold.patch | 4 ++-- gnu/packages/patches/webkitgtk-bind-all-fonts.patch | 2 +- gnu/packages/python-xyz.scm | 2 +- gnu/packages/unicode.scm | 2 +- gnu/packages/xorg.scm | 2 +- gnu/services/sound.scm | 2 +- guix/build-system/renpy.scm | 2 +- guix/build/emacs-utils.scm | 2 +- guix/build/renpy-build-system.scm | 2 +- 24 files changed, 25 insertions(+), 25 deletions(-) (limited to 'guix/build') diff --git a/doc/guix.texi b/doc/guix.texi index 9bb91b94fd..4bf14014eb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -70,7 +70,7 @@ Copyright @copyright{} 2019 Jakob L. Kreuze@* Copyright @copyright{} 2019 Kyle Andrews@* Copyright @copyright{} 2019 Alex Griffin@* Copyright @copyright{} 2019, 2020, 2021 Guillaume Le Vaillant@* -Copyright @copyright{} 2020 Leo Prikler@* +Copyright @copyright{} 2020 Liliana Marie Prikler@* Copyright @copyright{} 2019, 2020 Simon Tournier@* Copyright @copyright{} 2020 Wiktor Żelazny@* Copyright @copyright{} 2020 Damien Cassou@* diff --git a/gnu/packages/build-tools.scm b/gnu/packages/build-tools.scm index d2fb9e05df..7c44d2b80f 100644 --- a/gnu/packages/build-tools.scm +++ b/gnu/packages/build-tools.scm @@ -8,7 +8,7 @@ ;;; Copyright © 2018 Alex Vong ;;; Copyright © 2019, 2020 Brett Gilio ;;; Copyright © 2019 Jonathan Brielmaier -;;; Copyright © 2020 Leo Prikler +;;; Copyright © 2020 Liliana Marie Prikler ;;; Copyright © 2020 Yuval Kogman ;;; Copyright © 2020 Jakub Kądziołka ;;; Copyright © 2020 Efraim Flashner diff --git a/gnu/packages/convmv.scm b/gnu/packages/convmv.scm index 2a9a4ec68c..9e6f141818 100644 --- a/gnu/packages/convmv.scm +++ b/gnu/packages/convmv.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020 Leo Prikler +;;; Copyright © 2020 Liliana Marie Prikler ;;; ;;; This file is part of GNU Guix. ;;; diff --git a/gnu/packages/emacs-xyz.scm b/gnu/packages/emacs-xyz.scm index 2754ce7049..e390d87253 100644 --- a/gnu/packages/emacs-xyz.scm +++ b/gnu/packages/emacs-xyz.scm @@ -55,7 +55,7 @@ ;;; Copyright © 2019 Jelle Licht ;;; Copyright © 2019 Björn Höfling ;;; Copyright © 2019 Stephen Webber -;;; Copyright © 2019, 2021 Leo Prikler +;;; Copyright © 2019, 2021 Liliana Marie Prikler ;;; Copyright © 2019 David Wilson ;;; Copyright © 2020 Paul Garlick ;;; Copyright © 2020 Robert Smith diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm index 1edbaa463a..6d9950d068 100644 --- a/gnu/packages/emacs.scm +++ b/gnu/packages/emacs.scm @@ -18,7 +18,7 @@ ;;; Copyright © 2018, 2019, 2021 Tobias Geerinckx-Rice ;;; Copyright © 2019 Jesse John Gildersleve ;;; Copyright © 2019 Valentin Ignatev -;;; Copyright © 2019 Leo Prikler +;;; Copyright © 2019 Liliana Marie Prikler ;;; Copyright © 2019 Amin Bandali ;;; Copyright © 2020 Jack Hill ;;; Copyright © 2020 Morgan Smith diff --git a/gnu/packages/esolangs.scm b/gnu/packages/esolangs.scm index 45feedfa28..753221a5f1 100644 --- a/gnu/packages/esolangs.scm +++ b/gnu/packages/esolangs.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2016 Nikita ;;; Copyright © 2019 Tobias Geerinckx-Rice ;;; Copyright © 2020 Hendursaga -;;; Copyright © 2020 Leo Prikler +;;; Copyright © 2020 Liliana Marie Prikler ;;; ;;; This file is part of GNU Guix. ;;; diff --git a/gnu/packages/game-development.scm b/gnu/packages/game-development.scm index 7d185caa0e..039945467b 100644 --- a/gnu/packages/game-development.scm +++ b/gnu/packages/game-development.scm @@ -15,7 +15,7 @@ ;;; Copyright © 2017, 2019 Rutger Helling ;;; Copyright © 2018 Marius Bakke ;;; Copyright © 2019 Pierre Neidhardt -;;; Copyright © 2019, 2020, 2021 Leo Prikler +;;; Copyright © 2019, 2020, 2021 Liliana Marie Prikler ;;; Copyright © 2019 Jethro Cao ;;; Copyright © 2020, 2021 Nicolas Goaziou ;;; Copyright © 2020 Timotej Lazar diff --git a/gnu/packages/games.scm b/gnu/packages/games.scm index bd1802517b..e59d416905 100644 --- a/gnu/packages/games.scm +++ b/gnu/packages/games.scm @@ -53,7 +53,7 @@ ;;; Copyright © 2020 Vincent Legoll ;;; Copyright © 2020, 2021 Michael Rohleder ;;; Copyright © 2020 Trevor Hass -;;; Copyright © 2020, 2021 Leo Prikler +;;; Copyright © 2020, 2021 Liliana Marie Prikler ;;; Copyright © 2020 Lu hux ;;; Copyright © 2020 Tomás Ortín Fernández ;;; Copyright © 2021 Olivier Rojon diff --git a/gnu/packages/gnome-xyz.scm b/gnu/packages/gnome-xyz.scm index b9f7afcaf8..d4a6772254 100644 --- a/gnu/packages/gnome-xyz.scm +++ b/gnu/packages/gnome-xyz.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019, 2020, 2021 Leo Prikler +;;; Copyright © 2019, 2020, 2021 Liliana Marie Prikler ;;; Copyright © 2019, 2021 Alexandros Theodotou ;;; Copyright © 2019 Giacomo Leidi ;;; Copyright © 2020 Alex Griffin diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index 7de12fe525..f81e169abb 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -44,7 +44,7 @@ ;;; Copyright © 2019 David Wilson ;;; Copyright © 2019, 2020 Raghav Gururajan ;;; Copyright © 2019, 2020 Jonathan Brielmaier -;;; Copyright © 2019, 2020, 2021 Leo Prikler +;;; Copyright © 2019, 2020, 2021 Liliana Marie Prikler ;;; Copyright © 2020 Oleg Pykhalov ;;; Copyright © 2020 Pierre Neidhardt ;;; Copyright © 2020 raingloom diff --git a/gnu/packages/gstreamer.scm b/gnu/packages/gstreamer.scm index 3047773e0f..c734d0c74e 100644 --- a/gnu/packages/gstreamer.scm +++ b/gnu/packages/gstreamer.scm @@ -8,7 +8,7 @@ ;;; Copyright © 2017 Ricardo Wurmus ;;; Copyright © 2018, 2020 Tobias Geerinckx-Rice ;;; Copyright © 2019, 2020 Marius Bakke -;;; Copyright © 2020 Leo Prikler +;;; Copyright © 2020 Liliana Marie Prikler ;;; Copyright © 2020 Michael Rohleder ;;; ;;; This file is part of GNU Guix. diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm index 457701a436..7188058b42 100644 --- a/gnu/packages/guile-xyz.scm +++ b/gnu/packages/guile-xyz.scm @@ -31,7 +31,7 @@ ;;; Copyright © 2020, 2021 Masaya Tojo ;;; Copyright © 2020 Jesse Gibbons ;;; Copyright © 2020 Mike Rosset -;;; Copyright © 2020 Leo Prikler +;;; Copyright © 2020 Liliana Marie Prikler ;;; Copyright © 2020, 2021 pukkamustard ;;; Copyright © 2021 Bonface Munyoki Kilyungi ;;; Copyright © 2021 Xinglu Chen diff --git a/gnu/packages/minetest.scm b/gnu/packages/minetest.scm index fd1439d4d2..28fa40b410 100644 --- a/gnu/packages/minetest.scm +++ b/gnu/packages/minetest.scm @@ -6,7 +6,7 @@ ;;; Copyright © 2019 Marius Bakke ;;; Copyright © 2019–2021 Tobias Geerinckx-Rice ;;; Copyright © 2021 Trevor Hass -;;; Copyright © 2020, 2021 Leo Prikler +;;; Copyright © 2020, 2021 Liliana Marie Prikler ;;; Copyright © 2021 Maxime Devos ;;; This file is part of GNU Guix. ;;; diff --git a/gnu/packages/music.scm b/gnu/packages/music.scm index ff1330d228..4c77fb7461 100644 --- a/gnu/packages/music.scm +++ b/gnu/packages/music.scm @@ -33,7 +33,7 @@ ;;; Copyright © 2020 Marius Bakke ;;; Copyright © 2019 Riku Viitanen ;;; Copyright © 2020 Ryan Prior -;;; Copyright © 2021 Leo Prikler +;;; Copyright © 2021 Liliana Marie Prikler ;;; Copyright © 2021 Vinicius Monego ;;; Copyright © 2021 Brendan Tildesley ;;; Copyright © 2021 Bonface Munyoki Kilyungi diff --git a/gnu/packages/patches/minetest-add-MINETEST_MOD_PATH.patch b/gnu/packages/patches/minetest-add-MINETEST_MOD_PATH.patch index a74034a2c5..41338e6e6f 100644 --- a/gnu/packages/patches/minetest-add-MINETEST_MOD_PATH.patch +++ b/gnu/packages/patches/minetest-add-MINETEST_MOD_PATH.patch @@ -8,7 +8,7 @@ When it exists, Minetest will look there for mods in addition to ~/.minetest/mods/. Mods can still be installed to ~/.minetest/mods/ with the built-in installer. -With thanks to Leo Prikler. +With thanks to Liliana Marie Prikler. --- builtin/mainmenu/pkgmgr.lua | 7 +++---- doc/menu_lua_api.txt | 8 +++++++- diff --git a/gnu/packages/patches/ppsspp-disable-upgrade-and-gold.patch b/gnu/packages/patches/ppsspp-disable-upgrade-and-gold.patch index 155ba35efd..3a5ae1a2cd 100644 --- a/gnu/packages/patches/ppsspp-disable-upgrade-and-gold.patch +++ b/gnu/packages/patches/ppsspp-disable-upgrade-and-gold.patch @@ -1,9 +1,9 @@ From 942730ce7148cd54a30d4a606ce71a2654c8a2e0 Mon Sep 17 00:00:00 2001 -From: Leo Prikler +From: Liliana Marie Prikler Date: Sat, 5 Jun 2021 22:47:00 -0400 Subject: [PATCH] ppsspp: Remove upgrade code and gold support. -Original patch from Leo Prikler. +Original patch from Liliana Marie Prikler. Rebased on master (commit 69fa20744958aef8da9ca052ba7675fdc1636e46) by Maxim Cournoyer. --- diff --git a/gnu/packages/patches/webkitgtk-bind-all-fonts.patch b/gnu/packages/patches/webkitgtk-bind-all-fonts.patch index 3fe9704727..e7b06cc650 100644 --- a/gnu/packages/patches/webkitgtk-bind-all-fonts.patch +++ b/gnu/packages/patches/webkitgtk-bind-all-fonts.patch @@ -1,7 +1,7 @@ Add fonts from all XDG_DATA_DIRS, not just XDG_DATA_HOME. See . -Author: Leo Prikler +Author: Liliana Marie Prikler Index: webkitgtk-2.28.2/Source/WebKit/UIProcess/Launcher/glib/BubblewrapLauncher.cpp =================================================================== --- a/Source/WebKit/UIProcess/Launcher/glib/BubblewrapLauncher.cpp diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index 20502ac255..15a35cda17 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -89,7 +89,7 @@ ;;; Copyright © 2020, 2021 Bonface Munyoki Kilyungi ;;; Copyright © 2020 Ekaitz Zarraga ;;; Copyright © 2020 Diego N. Barbato -;;; Copyright © 2020 Leo Prikler +;;; Copyright © 2020 Liliana Marie Prikler ;;; Copyright © 2019 Kristian Trandem ;;; Copyright © 2020, 2021 Zheng Junjie <873216071@qq.com> ;;; Copyright © 2021 Morgan Smith diff --git a/gnu/packages/unicode.scm b/gnu/packages/unicode.scm index 2ecfebd379..806fe05fb6 100644 --- a/gnu/packages/unicode.scm +++ b/gnu/packages/unicode.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020 Leo Prikler +;;; Copyright © 2020 Liliana Marie Prikler ;;; Copyright © 2020 Efraim Flashner ;;; ;;; This file is part of GNU Guix. diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index b335435614..3b10573635 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -21,7 +21,7 @@ ;;; Copyright © 2019 nee ;;; Copyright © 2019 Yoshinori Arai ;;; Copyright © 2019 Mathieu Othacehe -;;; Copyright © 2020 Leo Prikler +;;; Copyright © 2020 Liliana Marie Prikler ;;; Copyright © 2020 Florian Pelz ;;; Copyright © 2020, 2021 Michael Rohleder ;;; Copyright © 2020 Maxim Cournoyer diff --git a/gnu/services/sound.scm b/gnu/services/sound.scm index bdf819b422..55610f27e0 100644 --- a/gnu/services/sound.scm +++ b/gnu/services/sound.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2020 Oleg Pykhalov -;;; Copyright © 2020 Leo Prikler +;;; Copyright © 2020 Liliana Marie Prikler ;;; Copyright © 2020 Marius Bakke ;;; ;;; This file is part of GNU Guix. diff --git a/guix/build-system/renpy.scm b/guix/build-system/renpy.scm index 35edc0056d..5ed59bf5a5 100644 --- a/guix/build-system/renpy.scm +++ b/guix/build-system/renpy.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Leo Prikler +;;; Copyright © 2021 Liliana Marie Prikler ;;; ;;; This file is part of GNU Guix. ;;; diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm index 5f7ba71244..64ef40e25a 100644 --- a/guix/build/emacs-utils.scm +++ b/guix/build/emacs-utils.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2014, 2018 Mark H Weaver ;;; Copyright © 2014 Alex Kost ;;; Copyright © 2018, 2020 Maxim Cournoyer -;;; Copyright © 2019 Leo Prikler +;;; Copyright © 2019 Liliana Marie Prikler ;;; ;;; This file is part of GNU Guix. ;;; diff --git a/guix/build/renpy-build-system.scm b/guix/build/renpy-build-system.scm index 66683971c5..e4a88456be 100644 --- a/guix/build/renpy-build-system.scm +++ b/guix/build/renpy-build-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Leo Prikler +;;; Copyright © 2021 Liliana Marie Prikler ;;; ;;; This file is part of GNU Guix. ;;; -- cgit v1.2.3 From a939011b58c65f4192a10cde9e925e85702bacf4 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Thu, 30 Sep 2021 03:58:42 +0200 Subject: build-system: linux-module: Normalise the ‘M’ source-directory. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit "make modules_install" with an "M=" file name ending in "/." breaks at least rtl8812au-aircrack-ng-linux-module. In general, passing a more human-generated-looking value seems prudent as these are more likely to be tested upstream. * guix/build/linux-module-build-system.scm (build, install): Call CANONICALIZE-PATH on SOURCE-DIRECTORY instead of STRING-APPEND. Reported by Maxim Cournoyer . as apteryx on #guix --- guix/build/linux-module-build-system.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/linux-module-build-system.scm b/guix/build/linux-module-build-system.scm index 729ab6154f..1541b6393e 100644 --- a/guix/build/linux-module-build-system.scm +++ b/guix/build/linux-module-build-system.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Danny Milosavljevic ;;; Copyright © 2020 Mathieu Othacehe +;;; Copyright © 2021 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. ;;; @@ -53,7 +54,7 @@ (define* (build #:key inputs make-flags (source-directory ".") #:allow-other-key (apply invoke "make" "-C" (string-append (assoc-ref inputs "linux-module-builder") "/lib/modules/build") - (string-append "M=" (getcwd) "/" source-directory) + (string-append "M=" (canonicalize-path source-directory)) (or make-flags '()))) ;; This block was copied from make-linux-libre--only took the "modules_install" @@ -68,7 +69,7 @@ (define* (install #:key make-flags (source-directory ".") (apply invoke "make" "-C" (string-append (assoc-ref inputs "linux-module-builder") "/lib/modules/build") - (string-append "M=" (getcwd) "/" source-directory) + (string-append "M=" (canonicalize-path source-directory)) ;; Disable depmod because the Guix system's module directory ;; is an union of potentially multiple packages. It is not ;; possible to use depmod to usefully calculate a dependency -- cgit v1.2.3 From 834415c33a2fd909e410a5cf352c597f05bb6999 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Fri, 1 Oct 2021 14:53:56 +0200 Subject: build-system: linux-module: Build and install in parallel. * guix/build-system/linux-module.scm (linux-module-build) (guix/build-system/linux-module.scm): Accept the PARALLEL-BUILD? keyword and pass it on to the builder. * guix/build/linux-module-build-system.scm (build, install): Capture and honour it. --- guix/build-system/linux-module.scm | 4 ++++ guix/build/linux-module-build-system.scm | 21 +++++++++++++++------ 2 files changed, 19 insertions(+), 6 deletions(-) (limited to 'guix/build') diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm index 33bc8c95df..548ed7a9aa 100644 --- a/guix/build-system/linux-module.scm +++ b/guix/build-system/linux-module.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Danny Milosavljevic ;;; Copyright © 2020 Mathieu Othacehe +;;; Copyright © 2021 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. ;;; @@ -157,6 +158,7 @@ (define* (linux-module-build store name inputs %standard-phases)) (outputs '("out")) (make-flags ''()) + (parallel-build? #t) (system (%current-system)) (source-directory ".") (guile #f) @@ -187,6 +189,7 @@ (define builder #:tests? ,tests? #:outputs %outputs #:make-flags ,make-flags + #:parallel-build? ,parallel-build? #:inputs %build-inputs))) (define guile-for-build @@ -213,6 +216,7 @@ (define* (linux-module-build-cross (guile #f) (outputs '("out")) (make-flags ''()) + (parallel-build? #t) (search-paths '()) (native-search-paths '()) (tests? #f) diff --git a/guix/build/linux-module-build-system.scm b/guix/build/linux-module-build-system.scm index 1541b6393e..7c0dba8445 100644 --- a/guix/build/linux-module-build-system.scm +++ b/guix/build/linux-module-build-system.scm @@ -50,16 +50,22 @@ (define* (configure #:key inputs target arch #:allow-other-keys) ; TODO: kernel ".config". #t) -(define* (build #:key inputs make-flags (source-directory ".") #:allow-other-keys) +(define* (build #:key (make-flags '()) (parallel-build? #t) + (source-directory ".") + inputs + #:allow-other-keys) (apply invoke "make" "-C" (string-append (assoc-ref inputs "linux-module-builder") "/lib/modules/build") (string-append "M=" (canonicalize-path source-directory)) - (or make-flags '()))) + `(,@(if parallel-build? + `("-j" ,(number->string (parallel-job-count))) + '()) + ,@make-flags))) -;; This block was copied from make-linux-libre--only took the "modules_install" -;; part. -(define* (install #:key make-flags (source-directory ".") +;; Similar to the "modules_install" part of make-linux-libre. +(define* (install #:key (make-flags '()) (parallel-build? #t) + (source-directory ".") inputs native-inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) @@ -80,7 +86,10 @@ (define* (install #:key make-flags (source-directory ".") (string-append "INSTALL_MOD_PATH=" out) "INSTALL_MOD_STRIP=1" "modules_install" - (or make-flags '())))) + `(,@(if parallel-build? + `("-j" ,(number->string (parallel-job-count))) + '()) + ,@make-flags)))) (define %standard-phases (modify-phases gnu:%standard-phases -- cgit v1.2.3 From bdd190e3aafa9b54ed93fefbe7c0307a9103d3ad Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Fri, 1 Oct 2021 15:02:43 +0200 Subject: build-system: linux-module: Don't explicitly return #t from phases. * guix/build-system/linux-module.scm (configure): Remove explicit #t return value. --- guix/build/linux-module-build-system.scm | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'guix/build') diff --git a/guix/build/linux-module-build-system.scm b/guix/build/linux-module-build-system.scm index 7c0dba8445..18ccf7cd8b 100644 --- a/guix/build/linux-module-build-system.scm +++ b/guix/build/linux-module-build-system.scm @@ -34,7 +34,7 @@ (define-module (guix build linux-module-build-system) ;; ;; Code: -;; Copied from make-linux-libre's "configure" phase. +;; Similar to make-linux-libre's "configure" phase. (define* (configure #:key inputs target arch #:allow-other-keys) (setenv "KCONFIG_NOTIMESTAMP" "1") (setenv "KBUILD_BUILD_TIMESTAMP" (getenv "SOURCE_DATE_EPOCH")) @@ -43,12 +43,11 @@ (define* (configure #:key inputs target arch #:allow-other-keys) (format #t "`ARCH' set to `~a'~%" (getenv "ARCH")) (when target + ;; TODO? (setenv "EXTRA_VERSION" ,extra-version) + ;; TODO? kernel ".config". (setenv "CROSS_COMPILE" (string-append target "-")) (format #t "`CROSS_COMPILE' set to `~a'~%" - (getenv "CROSS_COMPILE"))) - ; TODO: (setenv "EXTRA_VERSION" ,extra-version) - ; TODO: kernel ".config". - #t) + (getenv "CROSS_COMPILE")))) (define* (build #:key (make-flags '()) (parallel-build? #t) (source-directory ".") -- cgit v1.2.3 From 6d02a994f911a75e3a223a22c05c2939cdfed2b5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Oct 2021 23:03:41 +0200 Subject: download: Honor #:verify-certificate? for SWH downloads. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previously, the SWH + Disarchive fallback could fail with: Trying to use Disarchive to assemble /gnu/store/…-ucsim-0.6-pre68.tar.gz... Assembling the directory ucsim-0.6-pre68 Downloading /gnu/store/…-ucsim-0.6-pre68.tar.gz from Software Heritage... X.509 certificate of 'archive.softwareheritage.org' could not be verified: signer-not-found invalid Could not resolve directory reference This will no longer be the case since 'guix perform-download' passes #:verify-certificate? #f. * guix/build/download.scm (disarchive-fetch/any): Parameterize '%verify-swh-certificate?'. --- guix/build/download.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index 1ed623034b..fd8fe69901 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -674,7 +674,8 @@ (define (resolve addresses output) (match (fetch-specification uris) (#f (format #t "could not find its Disarchive specification~%") #f) - (spec (parameterize ((%disarchive-log-port (current-output-port))) + (spec (parameterize ((%disarchive-log-port (current-output-port)) + (%verify-swh-certificate? verify-certificate?)) (false-if-exception* (disarchive-assemble spec file #:resolver resolve)))))))) -- cgit v1.2.3 From 1660253c3c6cbc8757092c5464521868eb7f2cdc Mon Sep 17 00:00:00 2001 From: Hartmut Goebel Date: Thu, 28 May 2020 22:15:32 +0200 Subject: build-system: Add 'rebar3-build-system'. * guix/build-system/rebar3.scm, guix/build/rebar3-build-system.scm: New files. * Makefile.am (MODULES): Add them. --- Makefile.am | 2 + guix/build-system/rebar3.scm | 143 +++++++++++++++++++++++++++++++++++ guix/build/rebar3-build-system.scm | 150 +++++++++++++++++++++++++++++++++++++ 3 files changed, 295 insertions(+) create mode 100644 guix/build-system/rebar3.scm create mode 100644 guix/build/rebar3-build-system.scm (limited to 'guix/build') diff --git a/Makefile.am b/Makefile.am index ce79d4bc04..bb0b5989d2 100644 --- a/Makefile.am +++ b/Makefile.am @@ -163,6 +163,7 @@ MODULES = \ guix/build-system/waf.scm \ guix/build-system/r.scm \ guix/build-system/rakudo.scm \ + guix/build-system/rebar3.scm \ guix/build-system/ruby.scm \ guix/build-system/scons.scm \ guix/build-system/texlive.scm \ @@ -216,6 +217,7 @@ MODULES = \ guix/build/r-build-system.scm \ guix/build/renpy-build-system.scm \ guix/build/rakudo-build-system.scm \ + guix/build/rebar3-build-system.scm \ guix/build/ruby-build-system.scm \ guix/build/scons-build-system.scm \ guix/build/texlive-build-system.scm \ diff --git a/guix/build-system/rebar3.scm b/guix/build-system/rebar3.scm new file mode 100644 index 0000000000..af0d0edc59 --- /dev/null +++ b/guix/build-system/rebar3.scm @@ -0,0 +1,143 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Ricardo Wurmus +;;; Copyright © 2020 Hartmut Goebel +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (guix build-system rebar3) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:export (%rebar3-build-system-modules + rebar3-build + rebar3-build-system)) + +;; +;; Standard build procedure for Erlang packages using Rebar3. +;; + +(define %rebar3-build-system-modules + ;; Build-side modules imported by default. + `((guix build rebar3-build-system) + ,@%gnu-build-system-modules)) + +(define (default-rebar3) + "Return the default Rebar3 package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((erlang-mod (resolve-interface '(gnu packages erlang)))) + (module-ref erlang-mod 'rebar3))) + +(define (default-erlang) + "Return the default Erlang package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((erlang-mod (resolve-interface '(gnu packages erlang)))) + (module-ref erlang-mod 'erlang))) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (rebar (default-rebar3)) + (erlang (default-erlang)) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + '(#:source #:target #:rebar #:inputs #:native-inputs)) + + (and (not target) ;XXX: no cross-compilation + (bag + (name name) + (system system) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs)) + (build-inputs `(("rebar" ,rebar) + ("erlang" ,erlang) ;; for escriptize + ,@native-inputs + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (outputs outputs) + (build rebar3-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define* (rebar3-build store name inputs + #:key + (tests? #t) + (test-target "eunit") + (configure-flags ''()) + (make-flags ''("skip_deps=true" "-vv")) + (build-target "compile") + ;; TODO: pkg-name + (phases '(@ (guix build rebar3-build-system) + %standard-phases)) + (outputs '("out")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %rebar3-build-system-modules) + (modules '((guix build rebar3-build-system) + (guix build utils)))) + "Build SOURCE with INPUTS." + (define builder + `(begin + (use-modules ,@modules) + (rebar3-build #:name ,name + #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:make-flags ,make-flags + #:configure-flags ,configure-flags + #:system ,system + #:tests? ,tests? + #:test-target ,test-target + #:build-target ,build-target + #:phases ,phases + #:outputs %outputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:inputs %build-inputs))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system #:graft? #f)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages commencement))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system #:graft? #f))))) + + (build-expression->derivation store name builder + #:inputs inputs + #:system system + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build)) + +(define rebar3-build-system + (build-system + (name 'rebar3) + (description "The standard Rebar3 build system") + (lower lower))) diff --git a/guix/build/rebar3-build-system.scm b/guix/build/rebar3-build-system.scm new file mode 100644 index 0000000000..d503fc9944 --- /dev/null +++ b/guix/build/rebar3-build-system.scm @@ -0,0 +1,150 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016, 2018 Ricardo Wurmus +;;; Copyright © 2019 Björn Höfling +;;; Copyright © 2020 Hartmut Goebel +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (guix build rebar3-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module ((guix build utils) #:hide (delete)) + #:use-module (ice-9 match) + #:use-module (ice-9 ftw) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (%standard-phases + rebar3-build)) + +;; +;; Builder-side code of the standard build procedure for Erlang packages using +;; rebar3. +;; +;; TODO: Think about whether bindir ("ebin"), libdir ("priv") and includedir +;; "(include") need to be configurable + +(define %erlang-libdir "/lib/erlang/lib") + +(define* (erlang-depends #:key inputs #:allow-other-keys) + (define input-directories + (match inputs + (((_ . dir) ...) + dir))) + (mkdir-p "_checkouts") + + (for-each + (lambda (input-dir) + (let ((elibdir (string-append input-dir %erlang-libdir))) + (when (directory-exists? elibdir) + (for-each + (lambda (dirname) + (symlink (string-append elibdir "/" dirname) + (string-append "_checkouts/" dirname))) + (list-directories elibdir))))) + input-directories) + #t) + +(define* (unpack #:key source #:allow-other-keys) + "Unpack SOURCE in the working directory, and change directory within the +source. When SOURCE is a directory, copy it in a sub-directory of the current +working directory." + ;; archives from hexpm typicalls do not contain a directory level + ;; TODO: Check if archive contains a directory level + (mkdir "source") + (chdir "source") + (if (file-is-directory? source) + (begin + ;; Preserve timestamps (set to the Epoch) on the copied tree so that + ;; things work deterministically. + (copy-recursively source "." + #:keep-mtime? #t)) + (begin + (if (string-suffix? ".zip" source) + (invoke "unzip" source) + (invoke "tar" "xvf" source)))) + #t) + +(define* (build #:key (make-flags '()) (build-target "compile") + #:allow-other-keys) + (apply invoke `("rebar3" ,build-target ,@make-flags))) + +(define* (check #:key target (make-flags '()) (tests? (not target)) + (test-target "eunit") + #:allow-other-keys) + (if tests? + (apply invoke `("rebar3" ,test-target ,@make-flags)) + (format #t "test suite not run~%")) + #t) + +(define (erlang-package? name) + "Check if NAME correspond to the name of an Erlang package." + (string-prefix? "erlang-" name)) + +(define (package-name-version->erlang-name name+ver) + "Convert the Guix package NAME-VER to the corresponding Erlang name-version +format. Essentially drop the prefix used in Guix and replace dashes by +underscores." + (let* ((name- (package-name->name+version name+ver))) + (string-join + (string-split + (if (erlang-package? name-) ; checks for "erlang-" prefix + (string-drop name- (string-length "erlang-")) + name-) + #\-) + "_"))) + +(define (list-directories directory) + "Return file names of the sub-directory of DIRECTORY." + (scandir directory + (lambda (file) + (and (not (member file '("." ".."))) + (file-is-directory? (string-append directory "/" file)))))) + +(define* (install #:key name outputs + (pkg-name (package-name-version->erlang-name name)) + #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (build-dir "_build/default/lib") + (pkg-dir (string-append out %erlang-libdir "/" pkg-name))) + (for-each + (lambda (pkg) + (for-each + (lambda (dirname) + (let ((src-dir (string-append build-dir "/" pkg "/" dirname)) + (dst-dir (string-append pkg-dir "/" dirname))) + (when (file-exists? src-dir) + (copy-recursively src-dir dst-dir #:follow-symlinks? #t)) + (false-if-exception + (delete-file (string-append dst-dir "/.gitignore"))))) + '("ebin" "include" "priv"))) + (list-directories build-dir)) + (false-if-exception + (delete-file (string-append pkg-dir "/priv/Run-eunit-loop.expect"))) + #t)) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (replace 'unpack unpack) + (delete 'bootstrap) + (delete 'configure) + (add-before 'build 'erlang-depends erlang-depends) + (replace 'build build) + (replace 'check check) + (replace 'install install))) + +(define* (rebar3-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given Erlang package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) -- cgit v1.2.3 From fe56213027d9828c61fa06211458a23f32431e0b Mon Sep 17 00:00:00 2001 From: John Kehayias Date: Wed, 21 Jul 2021 00:20:29 +0200 Subject: guix: haskell-build-system: Always pass -package-db option. * guix/build/haskell-build-system.scm (run-setuphs): Pass -package-db option. Signed-off-by: Ricardo Wurmus --- guix/build/haskell-build-system.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index 28253ce2f0..171100ecf7 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2015 Paul van der Walt ;;; Copyright © 2018, 2020 Ricardo Wurmus ;;; Copyright © 2018 Alex Vong +;;; Copyright © 2021 John Kehayias ;;; ;;; This file is part of GNU Guix. ;;; @@ -63,13 +64,14 @@ (define (run-setuphs command params) ((file-exists? "Setup.lhs") "Setup.lhs") (else - #f)))) + #f))) + (pkgdb (string-append "-package-db=" %tmp-db-dir))) (if setup-file (begin (format #t "running \"runhaskell Setup.hs\" with command ~s \ and parameters ~s~%" command params) - (apply invoke "runhaskell" setup-file command params)) + (apply invoke "runhaskell" pkgdb setup-file command params)) (error "no Setup.hs nor Setup.lhs found")))) (define* (configure #:key outputs inputs tests? (configure-flags '()) -- cgit v1.2.3 From 7cdb65dc9cceebfd3a45eeb281530f91f1b43b81 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Fri, 17 Sep 2021 08:55:08 +0200 Subject: build-system/haskell: Do not rely on compiler name. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit We’ve been relying on the compiler name matching its package subdir. Since we effectively only support GHC we can hard-code this and avoid issues with “ghc-next”. * guix/build/haskell-build-system.scm (make-ghc-package-database): Use GHC_PACKAGE_PATH. (register): Hard-code ghc prefix. --- guix/build/haskell-build-system.scm | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) (limited to 'guix/build') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index 171100ecf7..7d50bae721 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -175,15 +175,8 @@ (define (make-ghc-package-database system inputs outputs) "Generate the GHC package database." (let* ((haskell (assoc-ref inputs "haskell")) (name-version (strip-store-file-name haskell)) - (input-dirs (match inputs - (((_ . dir) ...) - dir) - (_ '()))) ;; Silence 'find-files' (see 'evaluate-search-paths') - (conf-dirs (with-null-error-port - (search-path-as-list - `(,(string-append "lib/" name-version)) - input-dirs #:pattern ".*\\.conf.d$"))) + (conf-dirs (search-path-as-string->list (getenv "GHC_PACKAGE_PATH"))) (conf-files (append-map (cut find-files <> "\\.conf$") conf-dirs))) (mkdir-p %tmp-db-dir) (for-each (lambda (file) @@ -243,10 +236,11 @@ (define (install-transitive-deps conf-file src dest) (let* ((out (assoc-ref outputs "out")) (doc (assoc-ref outputs "doc")) (haskell (assoc-ref inputs "haskell")) - (name-verion (strip-store-file-name haskell)) + (name-version (strip-store-file-name haskell)) + (version (last (string-split name-version #\-))) (lib (string-append (or (assoc-ref outputs "lib") out) "/lib")) (config-dir (string-append lib - "/" name-verion + "/ghc-" version "/" name ".conf.d")) (id-rx (make-regexp "^id: *(.*)$")) (config-file (string-append out "/" name ".conf")) -- cgit v1.2.3 From a01daed62c24d62e8350ce15d7a19aed37289807 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Fri, 17 Sep 2021 10:17:33 +0200 Subject: build-system/haskell: Accept line breaks in config files. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Long id’s will break to the next line. * guix/build/haskell-build-system.scm (grep): Remove. (register): Modify regular expression to account for newlines between key and value, fail if package id is empty. --- guix/build/haskell-build-system.scm | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) (limited to 'guix/build') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index 7d50bae721..4d0bf6f38a 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -143,17 +143,6 @@ (define* (install #:key outputs #:allow-other-keys) (find-files lib "\\.a$")))) #t) -(define (grep rx port) - "Given a regular-expression RX including a group, read from PORT until the -first match and return the content of the group." - (let ((line (read-line port))) - (if (eof-object? line) - #f - (let ((rx-result (regexp-exec rx line))) - (if rx-result - (match:substring rx-result 1) - (grep rx port)))))) - (define* (setup-compiler #:key system inputs outputs #:allow-other-keys) "Setup the compiler environment." (let* ((haskell (assoc-ref inputs "haskell")) @@ -242,7 +231,7 @@ (define (install-transitive-deps conf-file src dest) (config-dir (string-append lib "/ghc-" version "/" name ".conf.d")) - (id-rx (make-regexp "^id: *(.*)$")) + (id-rx (make-regexp "^id:[ \n\t]+([^ \t\n]+)$" regexp/newline)) (config-file (string-append out "/" name ".conf")) (params (list (string-append "--gen-pkg-config=" config-file)))) @@ -250,8 +239,15 @@ (define (install-transitive-deps conf-file src dest) ;; The conf file is created only when there is a library to register. (when (file-exists? config-file) (mkdir-p config-dir) - (let ((config-file-name+id - (call-with-ascii-input-file config-file (cut grep id-rx <>)))) + (let* ((contents (call-with-input-file config-file read-string)) + (config-file-name+id (match:substring (first (list-matches id-rx contents)) 1))) + + (when (or + (and + (string? config-file-name+id) + (string-null? config-file-name+id)) + (not config-file-name+id)) + (error (format #f "The package id for ~a is empty. This is a bug." config-file))) ;; Remove reference to "doc" output from "lib" (or "out") by rewriting the ;; "haddock-interfaces" field and removing the optional "haddock-html" -- cgit v1.2.3 From b74ca403cbb11c60d57b6a0148d97c6572019754 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Sun, 19 Sep 2021 11:10:16 +0200 Subject: build-system/haskell: Explain failure. Provide human-readable failure message and explain how to fix it. * guix/build/haskell-build-system.scm (register): Raise error if source file does not exist. --- guix/build/haskell-build-system.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'guix/build') diff --git a/guix/build/haskell-build-system.scm b/guix/build/haskell-build-system.scm index 4d0bf6f38a..ef6cb316ee 100644 --- a/guix/build/haskell-build-system.scm +++ b/guix/build/haskell-build-system.scm @@ -217,6 +217,8 @@ (define (install-transitive-deps conf-file src dest) (if (not (vhash-assoc id seen)) (let ((dep-conf (string-append src "/" id ".conf")) (dep-conf* (string-append dest "/" id ".conf"))) + (when (not (file-exists? dep-conf)) + (error (format #f "File ~a does not exist. This usually means the dependency ~a is missing. Was checking conf-file ~a." dep-conf id conf-file))) (copy-file dep-conf dep-conf*) ;XXX: maybe symlink instead? (loop (vhash-cons id #t seen) (append lst (conf-depends dep-conf)))) -- cgit v1.2.3 From a1679b74c9aa20bb51bc4add82ebb7ba78926b9c Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Fri, 8 Oct 2021 23:26:24 +0200 Subject: Revert the #51061 patch series for now. This reverts commits f63c79bf7674df012517f8e9148f94c611e35f32 ..f86f7e24b39928247729020df0134e2e1c4cde62 for more chillax reviewing. See . --- Makefile.am | 5 - gnu/packages/erlang.scm | 492 ------------------------------------- guix/build-system/rebar3.scm | 143 ----------- guix/build/rebar3-build-system.scm | 150 ----------- guix/hexpm-download.scm | 76 ------ guix/import/hexpm.scm | 290 ---------------------- guix/import/utils.scm | 1 - guix/scripts/import.scm | 2 +- guix/scripts/import/hexpm.scm | 114 --------- guix/upstream.scm | 20 +- 10 files changed, 2 insertions(+), 1291 deletions(-) delete mode 100644 guix/build-system/rebar3.scm delete mode 100644 guix/build/rebar3-build-system.scm delete mode 100644 guix/hexpm-download.scm delete mode 100644 guix/import/hexpm.scm delete mode 100644 guix/scripts/import/hexpm.scm (limited to 'guix/build') diff --git a/Makefile.am b/Makefile.am index bb0b5989d2..f2b6c8e8da 100644 --- a/Makefile.am +++ b/Makefile.am @@ -99,7 +99,6 @@ MODULES = \ guix/extracting-download.scm \ guix/git-download.scm \ guix/hg-download.scm \ - guix/hexpm-download.scm \ guix/swh.scm \ guix/monads.scm \ guix/monad-repl.scm \ @@ -163,7 +162,6 @@ MODULES = \ guix/build-system/waf.scm \ guix/build-system/r.scm \ guix/build-system/rakudo.scm \ - guix/build-system/rebar3.scm \ guix/build-system/ruby.scm \ guix/build-system/scons.scm \ guix/build-system/texlive.scm \ @@ -217,7 +215,6 @@ MODULES = \ guix/build/r-build-system.scm \ guix/build/renpy-build-system.scm \ guix/build/rakudo-build-system.scm \ - guix/build/rebar3-build-system.scm \ guix/build/ruby-build-system.scm \ guix/build/scons-build-system.scm \ guix/build/texlive-build-system.scm \ @@ -265,7 +262,6 @@ MODULES = \ guix/import/gnu.scm \ guix/import/go.scm \ guix/import/hackage.scm \ - guix/import/hexpm.scm \ guix/import/json.scm \ guix/import/kde.scm \ guix/import/launchpad.scm \ @@ -313,7 +309,6 @@ MODULES = \ guix/scripts/import/gnu.scm \ guix/scripts/import/go.scm \ guix/scripts/import/hackage.scm \ - guix/scripts/import/hexpm.scm \ guix/scripts/import/json.scm \ guix/scripts/import/minetest.scm \ guix/scripts/import/opam.scm \ diff --git a/gnu/packages/erlang.scm b/gnu/packages/erlang.scm index 13235c6f1f..32bc12ebb8 100644 --- a/gnu/packages/erlang.scm +++ b/gnu/packages/erlang.scm @@ -4,7 +4,6 @@ ;;; Copyright © 2016, 2017 Pjotr Prins ;;; Copyright © 2018 Tobias Geerinckx-Rice ;;; Copyright © 2018 Nikita -;;; Copyright © 2020, 2021 Hartmut Goebel ;;; Copyright © 2021 Oskar Köök ;;; Copyright © 2021 Cees de Groot ;;; @@ -27,10 +26,8 @@ (define-module (gnu packages erlang) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix build-system gnu) #:use-module (guix build-system emacs) - #:use-module (guix build-system rebar3) #:use-module (guix download) #:use-module (guix git-download) - #:use-module (guix hexpm-download) #:use-module (guix packages) #:use-module (guix utils) #:use-module (gnu packages) @@ -38,7 +35,6 @@ (define-module (gnu packages erlang) #:use-module (gnu packages gl) #:use-module (gnu packages ncurses) #:use-module (gnu packages perl) - #:use-module (gnu packages version-control) #:use-module (gnu packages tls) #:use-module (gnu packages wxwidgets)) @@ -225,491 +221,3 @@ (define-public emacs-erlang "This package provides an Emacs major mode for editing Erlang source files.") (license license:asl2.0))) - -(define-public erlang-bbmustache - (package - (name "erlang-bbmustache") - (version "1.12.1") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "bbmustache" version)) - (sha256 - (base32 "0wbfayx6940zf57bpwg1m9sk3cpgam2q8n0w74alkrc4gc7hn47w")))) - (build-system rebar3-build-system) - (inputs - `(("erlang-edown" ,erlang-edown) - ("erlang-getopt" ,erlang-getopt) - ("erlang-rebar3-git-vsn" ,erlang-rebar3-git-vsn))) - (arguments - `(#:tests? #f ;; requires mustache specification file - #:phases - (modify-phases %standard-phases - (add-after 'build 'build-escript - (lambda _ - (invoke "rebar3" "as" "dev" "escriptize"))) - (add-after 'install 'install-escript - (lambda* (#:key outputs #:allow-other-keys) - (let* ((out (assoc-ref outputs "out"))) - (install-file "_build/dev/bin/bbmustache" - (string-append out "/bin"))) - #t))))) - (home-page "https://github.com/soranoba/bbmustache/") - (synopsis "Binary pattern match Based Mustache template engine for Erlang") - (description "This Erlang library provides a Binary pattern match Based -Mustache template engine") - (license license:expat))) - -(define-public erlang-certifi - (package - (name "erlang-certifi") - (version "2.7.0") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "certifi" version)) - (sha256 - (base32 "1ssiajvll5nilrnsg23ja3qz2fmvnbhy176c8i0gqj0h1alismn9")))) - (build-system rebar3-build-system) - (inputs - `(("parse-trans" ,erlang-parse-trans))) - (home-page "https://github.com/certifi/erlang-certifi/") - (synopsis "CA bundle adapted from Mozilla for Erlang") - (description "This Erlang library contains a CA bundle that you can -reference in your Erlang application. This is useful for systems that do not -have CA bundles that Erlang can find itself, or where a uniform set of CAs is -valuable. - -This an Erlang specific port of certifi. The CA bundle is derived from -Mozilla's canonical set.") - (license license:bsd-3))) - -(define-public erlang-cf - (package - (name "erlang-cf") - (version "0.3.1") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "cf" version)) - (sha256 - (base32 "0vnmbb1n899xw2p4x6c3clpzxcqqdsfbfhh1dfy530i3201vr2h4")))) - (build-system rebar3-build-system) - (home-page "https://github.com/project-fifo/cf") - (synopsis "Terminal colour helper for Erlang io and io_lib") - (description "This package provides a helper library for termial colour -printing extending the io:format syntax to add colours.") - (license license:expat))) - -(define-public erlang-covertool - (package - (name "erlang-covertool") - (version "2.0.4") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "covertool" version)) - (sha256 - (base32 "10krv66nabzrgkz4k3gfp7zx1x9030vnkhc0n1f1chwzwf4sa6nx")))) - (build-system rebar3-build-system) - (home-page "https://github.com/covertool/covertool") - (synopsis "Convert Erlang cover data into Cobertura XML reports") - (description "This package provides a build tool and plugin to convert -exported Erlang cover data sets into Cobertura XML reports, which can then be -feed to the Jenkins Cobertura plug-in. - -On @emph{hex.pm}, this plugin was previously called @code{rebar_covertool}.") - (license license:bsd-2))) - -(define-public erlang-cth-readable - (package - (name "erlang-cth-readable") - (version "1.5.1") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "cth_readable" version)) - (sha256 - (base32 "0hqzgd8fvs4d1bhpm6dkm3bm2jik4qbl78s514r5ivwjxw1dzrds")))) - (build-system rebar3-build-system) - (propagated-inputs - `(("erlang-cf" ,erlang-cf))) - (arguments - `(#:tests? #f)) ;; no test-suite - (home-page "https://github.com/ferd/cth_readable") - (synopsis "Common Test hooks for more readable logs for Erlang") - (description "This package provides an OTP library to be used for CT log -outputs you want to be readable around all that noise they contain.") - (license license:bsd-3))) - -(define-public erlang-edown - (package - (name "erlang-edown") - (version "0.8.4") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "edown" version)) - (sha256 - (base32 "1khk5yxqjix2irsr02i0zpkv52myakpw4ahsr4fcy81l3xlk58dx")))) - (build-system rebar3-build-system) - (home-page "https://github.com/uwiger/edown") - (synopsis "Markdown extension for EDoc") - (description "This package provides an extension for EDoc for generating -Markdown.") - (license license:asl2.0))) - -(define-public erlang-erlware-commons - (package - (name "erlang-erlware-commons") - (version "1.6.0") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "erlware_commons" version)) - (sha256 - (base32 "0xc3kiylingqrrnzhxm2j2n5gr3hxqgpibhi9nva9bwjs4n155fm")))) - (build-system rebar3-build-system) - (propagated-inputs - `(("erlang-cf" ,erlang-cf))) - (native-inputs - `(("git" ,git))) ;; Required for tests - (arguments - `(#:tests? #f)) ;; TODO: 1/219 tests fail - very simple one, though - (home-page "http://erlware.github.io/erlware_commons/") - (synopsis "Additional standard library for Erlang") - (description "Erlware Commons is an Erlware project focused on all aspects -of reusable Erlang components.") - (license license:expat))) - -(define-public erlang-eunit-formatters - (package - (name "erlang-eunit-formatters") - (version "0.5.0") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "eunit_formatters" version)) - (sha256 - (base32 "18q3vb12799584kdb998298b6bfh686mzi5s7pkb7djrf93vgf5f")))) - (build-system rebar3-build-system) - (home-page "https://github.com/seancribbs/eunit_formatters") - (synopsis "Better output for eunit suites") - (description "This package provides a better output for Erlang eunits.") - (license license:asl2.0))) - -(define-public erlang-getopt - (package - (name "erlang-getopt") - (version "1.0.2") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "getopt" version)) - (sha256 - (base32 "1yxs36l1ll56zrxn81kw5qd8fv1q14myhjylk7dk31palg7jl725")))) - (build-system rebar3-build-system) - (home-page "https://github.com/jcomellas/getopt") - (synopsis "Command-line options parser for Erlang") - (description "This package provides an Erlang module to parse command line -arguments using the GNU getopt syntax.") - (license license:bsd-3))) - -(define-public erlang-hex-core - (package - (name "erlang-hex-core") - (version "0.8.2") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "hex_core" version)) - (sha256 - (base32 "15fybnqxl5lzkpd8fjj1fxmj8cxcdpkxn0cvwc41cv0vxv3pw797")))) - (build-system rebar3-build-system) - (arguments - `(#:phases - (modify-phases %standard-phases - (replace 'check - (lambda* (#:key tests? #:allow-other-keys) - (when tests? - (invoke "rebar3" "as" "test" "proper"))))))) - (inputs - `(("erlang-proper" ,erlang-proper) - ("erlang-rebar3-proper" ,erlang-rebar3-proper))) - (propagated-inputs - `(("erlang-getopt" ,erlang-getopt))) - (home-page "https://github.com/hexpm/hex_core") - (synopsis "Reference implementation of Hex specifications") - (description "This package provides the reference implementation of Hex -specifications.") - (license license:asl2.0))) - -(define-public erlang-jsone - (package - (name "erlang-jsone") - (version "1.6.1") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "jsone" version)) - (sha256 - (base32 "1wdbj4a736bg2fh4qk7y3h6lsdi84ivvypgbkphzy0mfz7nkc97p")))) - (build-system rebar3-build-system) - (arguments - `(#:phases - (modify-phases %standard-phases - (add-after 'unpack 'disable-covertool - (lambda _ - (substitute* "rebar.config" - (("\\{project_plugins, \\[covertool\\]\\}\\." _) ""))))))) - (home-page "https://github.com/sile/jsone/") - (synopsis "Erlang JSON Library") - (description "An Erlang library for encoding and decoding JSON data.") - (license license:expat))) - -(define-public erlang-parse-trans - (package - (name "erlang-parse-trans") - (version "3.4.1") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "parse_trans" version)) - (sha256 - (base32 "1g3ablipihi8z64j9195pmrlf7gymyi21j2da9y509igs3q1sxfc")))) - (build-system rebar3-build-system) - (inputs - `(("erlang-getopt" ,erlang-getopt))) - (home-page "https://github.com/uwiger/parse_trans") - (synopsis "Parse transform utilities for Erlang") - (description "This package provides parse transform utilities for -Erlang.") - (license license:asl2.0))) - -(define-public erlang-proper - (package - (name "erlang-proper") - (version "1.4.0") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "proper" version)) - (sha256 - (base32 "1b0srk0swbns6807vxwhj1hfrql7r14arysaax99kvl12f4q3qci")))) - (build-system rebar3-build-system) - (arguments - `(#:phases - (modify-phases %standard-phases - (add-after 'unpack 'disable-covertool - (lambda _ - (substitute* "rebar.config" - (("\\{plugins, \\[covertool\\]\\}\\." _) ""))))))) - (home-page "https://proper-testing.github.io/") - (synopsis "QuickCheck-inspired property-based testing tool for Erlang") - (description "PropEr is a tool for the automated, semi-random, -property-based testing of Erlang programs. It is fully integrated with -Erlang's type language, and can also be used for the model-based random -testing of stateful systems.") - (license license:gpl3+))) - -(define-public erlang-providers - (package - (name "erlang-providers") - (version "1.9.0") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "providers" version)) - (sha256 - (base32 "0rq5zrqrsv2zgg84yfgh1faahnl4hkn92lja43iqihyiy181813z")))) - (propagated-inputs - `(("erlang-cf" ,erlang-cf) - ("erlang-erlware-commons" ,erlang-erlware-commons) - ("erlang-getopt" ,erlang-getopt))) - (build-system rebar3-build-system) - (home-page "https://github.com/tsloughter/providers") - (synopsis "Erlang providers library") - (description "This package provides an Erlang providers library.") - (license license:asl2.0))) - -(define-public erlang-rebar3-git-vsn - (package - (name "erlang-rebar3-git-vsn") - (version "1.1.1") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "rebar3_git_vsn" version)) - (sha256 - (base32 "1ra4xjyc40r97aqb8aq2rll1v8wkf9jyisnbk34xdqcgv9s9iw7d")))) - (build-system rebar3-build-system) - (inputs - `(("git" ,git))) - (arguments - `(;; Running the tests require binary artifact (tar-file containing - ;; samples git repos) - #:tests? #f - #:phases - (modify-phases %standard-phases - (add-after 'unpack 'patch-path - (lambda* (#:key inputs #:allow-other-keys) - (let ((git (assoc-ref inputs "git"))) - (substitute* "src/rebar3_git_vsn.erl" - (("rebar_utils:sh\\(\"git " _) - (string-append "rebar_utils:sh(\"" git "/bin/git "))))))))) - (home-page "https://github.com/soranoba/rebar3_git_vsn") - (synopsis "Rebar3 plugin for generating the version from git") - (description "This plugin adds support for generating the version from -a git checkout.") - (license license:expat))) - -(define-public erlang-rebar3-proper - (package - (name "erlang-rebar3-proper") - (version "0.12.1") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "rebar3_proper" version)) - (sha256 - (base32 "0j3a9byxbdrfinynq2xdz5mz7s4vpdlsmv7lln80lpqxswnafpfv")))) - (build-system rebar3-build-system) - (home-page "https://github.com/ferd/rebar3_proper") - (synopsis "Rebar3 PropEr plugin") - (description "This plugin allows running PropEr test suites from within -rebar3.") - (license license:bsd-3))) - -(define-public erlang-rebar3-raw-deps - (package - (name "erlang-rebar3-raw-deps") - (version "2.0.0") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "rebar3_raw_deps" version)) - (sha256 - (base32 "1w8whb86yl2mpv67biqnwaam8xpm4pq8yyidifzj1svjyd37hxv7")))) - (build-system rebar3-build-system) - (home-page "https://github.com/soranoba/rebar3_raw_deps") - (synopsis "Rebar3 plugin for supporting \"raw\" dependencies") - (description "This plugin adds support for \"raw\" dependencies to -rebar3.") - (license license:expat))) - -(define-public erlang-relx - (package - (name "erlang-relx") - (version "4.5.0") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "relx" version)) - (sha256 - (base32 "12fjcb5b992ixxkc7v7v55ln1i5qak7dzmzqvf6hx50l1ip3hh58")))) - (build-system rebar3-build-system) - (propagated-inputs - `(("erlang-bbmustache" ,erlang-bbmustache) - ("erlang-cf" ,erlang-cf) - ("erlang-erlware-commons" ,erlang-erlware-commons) - ("erlang-getopt" ,erlang-getopt) - ("erlang-providers" ,erlang-providers))) - (home-page "https://erlware.github.io/relx/") - (synopsis "Release assembler for Erlang/OTP Releases") - (description "Relx assembles releases for an Erlang/OTP release. Given a -release specification and a list of directories in which to search for OTP -applications it will generate a release output. That output depends heavily on -what plugins available and what options are defined, but usually it is simply -a well configured release directory.") - (license license:asl2.0))) - -(define-public erlang-ssl-verify-fun - (package - (name "erlang-ssl-verify-fun") - (version "1.1.6") - (source - (origin - (method hexpm-fetch) - (uri (hexpm-uri "ssl_verify_fun" version)) - (sha256 - (base32 "0bwdqhnmlv0jfs5mrws2a75zngiihnvcni2hj4l65r5abnw050vx")))) - (build-system rebar3-build-system) - (home-page "https://github.com/deadtrickster/ssl_verify_fun.erl") - (synopsis "SSL verification functions for Erlang") - (description "This package provides SSL verification functions for -Erlang.") - (license license:expat))) - -(define-public rebar3 - (package - (name "rebar3") - (version "3.17.0") - (source - (origin - (method git-fetch) - (uri (git-reference - (url "https://github.com/erlang/rebar3.git") - (commit version))) - (file-name (git-file-name name version)) - (sha256 - (base32 "02sk3whrbprzlih4pgcsd6ngmassfjfmkz21gwvb7mq64pib40k6")))) - (build-system gnu-build-system) - (arguments - `(#:phases - (modify-phases %standard-phases - (delete 'bootstrap) - (add-after 'unpack 'unpack-dependency-sources - (lambda* (#:key inputs #:allow-other-keys) - (for-each - (lambda (pkgname) - (let* ((src (string-append pkgname "-source")) - (input (assoc-ref inputs src)) - (checkouts-dir (string-append "_checkouts/" pkgname)) - (lib-dir (string-append "_build/default/lib/" pkgname))) - (mkdir-p checkouts-dir) - (invoke "tar" "-xzf" input "-C" checkouts-dir) - (mkdir-p lib-dir) - (copy-recursively checkouts-dir lib-dir))) - (list "bbmustache" "certifi" "cf" "cth_readable" - "eunit_formatters" "getopt" "hex_core" "erlware_commons" - "parse_trans" "relx" "ssl_verify_fun" "providers")) - #t)) - (delete 'configure) - (replace 'build - (lambda _ - (setenv "HOME" (getcwd)) - (invoke "./bootstrap"))) - (replace 'install - (lambda* (#:key outputs #:allow-other-keys) - (let* ((out (assoc-ref outputs "out"))) - (install-file "rebar3" (string-append out "/bin"))) - #t)) - (delete 'check)))) - (native-inputs - `(("erlang" ,erlang))) - (inputs - `(("bbmustache-source" ,(package-source erlang-bbmustache)) - ("certifi-source" ,(package-source erlang-certifi)) - ("cf-source" ,(package-source erlang-cf)) - ("cth_readable-source" ,(package-source erlang-cth-readable)) - ("erlware_commons-source" ,(package-source erlang-erlware-commons)) - ("eunit_formatters-source" ,(package-source erlang-eunit-formatters)) - ("getopt-source" ,(package-source erlang-getopt)) - ("hex_core-source" ,(package-source erlang-hex-core)) - ("parse_trans-source" ,(package-source erlang-parse-trans)) - ("relx-source" ,(package-source erlang-relx)) - ("ssl_verify_fun-source" ,(package-source erlang-ssl-verify-fun)) - ("providers-source" ,(package-source erlang-providers)))) - (home-page "https://www.rebar3.org/") - (synopsis "Sophisticated build-tool for Erlang projects that follows OTP -principles") - (description "@code{rebar3} is an Erlang build tool that makes it easy to -compile and test Erlang applications, port drivers and releases. - -@code{rebar3} is a self-contained Erlang script, so it's easy to distribute or -even embed directly in a project. Where possible, rebar uses standard -Erlang/OTP conventions for project structures, thus minimizing the amount of -build configuration work. @code{rebar3} also provides dependency management, -enabling application writers to easily re-use common libraries from a variety -of locations (git, hg, etc).") - (license license:asl2.0))) diff --git a/guix/build-system/rebar3.scm b/guix/build-system/rebar3.scm deleted file mode 100644 index af0d0edc59..0000000000 --- a/guix/build-system/rebar3.scm +++ /dev/null @@ -1,143 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Ricardo Wurmus -;;; Copyright © 2020 Hartmut Goebel -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix 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. -;;; -;;; GNU Guix 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 GNU Guix. If not, see . - -(define-module (guix build-system rebar3) - #:use-module (guix store) - #:use-module (guix utils) - #:use-module (guix packages) - #:use-module (guix derivations) - #:use-module (guix search-paths) - #:use-module (guix build-system) - #:use-module (guix build-system gnu) - #:use-module (ice-9 match) - #:use-module (srfi srfi-26) - #:export (%rebar3-build-system-modules - rebar3-build - rebar3-build-system)) - -;; -;; Standard build procedure for Erlang packages using Rebar3. -;; - -(define %rebar3-build-system-modules - ;; Build-side modules imported by default. - `((guix build rebar3-build-system) - ,@%gnu-build-system-modules)) - -(define (default-rebar3) - "Return the default Rebar3 package." - ;; Lazily resolve the binding to avoid a circular dependency. - (let ((erlang-mod (resolve-interface '(gnu packages erlang)))) - (module-ref erlang-mod 'rebar3))) - -(define (default-erlang) - "Return the default Erlang package." - ;; Lazily resolve the binding to avoid a circular dependency. - (let ((erlang-mod (resolve-interface '(gnu packages erlang)))) - (module-ref erlang-mod 'erlang))) - -(define* (lower name - #:key source inputs native-inputs outputs system target - (rebar (default-rebar3)) - (erlang (default-erlang)) - #:allow-other-keys - #:rest arguments) - "Return a bag for NAME." - (define private-keywords - '(#:source #:target #:rebar #:inputs #:native-inputs)) - - (and (not target) ;XXX: no cross-compilation - (bag - (name name) - (system system) - (host-inputs `(,@(if source - `(("source" ,source)) - '()) - ,@inputs)) - (build-inputs `(("rebar" ,rebar) - ("erlang" ,erlang) ;; for escriptize - ,@native-inputs - ;; Keep the standard inputs of 'gnu-build-system'. - ,@(standard-packages))) - (outputs outputs) - (build rebar3-build) - (arguments (strip-keyword-arguments private-keywords arguments))))) - -(define* (rebar3-build store name inputs - #:key - (tests? #t) - (test-target "eunit") - (configure-flags ''()) - (make-flags ''("skip_deps=true" "-vv")) - (build-target "compile") - ;; TODO: pkg-name - (phases '(@ (guix build rebar3-build-system) - %standard-phases)) - (outputs '("out")) - (search-paths '()) - (system (%current-system)) - (guile #f) - (imported-modules %rebar3-build-system-modules) - (modules '((guix build rebar3-build-system) - (guix build utils)))) - "Build SOURCE with INPUTS." - (define builder - `(begin - (use-modules ,@modules) - (rebar3-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:make-flags ,make-flags - #:configure-flags ,configure-flags - #:system ,system - #:tests? ,tests? - #:test-target ,test-target - #:build-target ,build-target - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) - - (define guile-for-build - (match guile - ((? package?) - (package-derivation store guile system #:graft? #f)) - (#f ; the default - (let* ((distro (resolve-interface '(gnu packages commencement))) - (guile (module-ref distro 'guile-final))) - (package-derivation store guile system #:graft? #f))))) - - (build-expression->derivation store name builder - #:inputs inputs - #:system system - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) - -(define rebar3-build-system - (build-system - (name 'rebar3) - (description "The standard Rebar3 build system") - (lower lower))) diff --git a/guix/build/rebar3-build-system.scm b/guix/build/rebar3-build-system.scm deleted file mode 100644 index d503fc9944..0000000000 --- a/guix/build/rebar3-build-system.scm +++ /dev/null @@ -1,150 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2018 Ricardo Wurmus -;;; Copyright © 2019 Björn Höfling -;;; Copyright © 2020 Hartmut Goebel -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix 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. -;;; -;;; GNU Guix 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 GNU Guix. If not, see . - -(define-module (guix build rebar3-build-system) - #:use-module ((guix build gnu-build-system) #:prefix gnu:) - #:use-module ((guix build utils) #:hide (delete)) - #:use-module (ice-9 match) - #:use-module (ice-9 ftw) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:export (%standard-phases - rebar3-build)) - -;; -;; Builder-side code of the standard build procedure for Erlang packages using -;; rebar3. -;; -;; TODO: Think about whether bindir ("ebin"), libdir ("priv") and includedir -;; "(include") need to be configurable - -(define %erlang-libdir "/lib/erlang/lib") - -(define* (erlang-depends #:key inputs #:allow-other-keys) - (define input-directories - (match inputs - (((_ . dir) ...) - dir))) - (mkdir-p "_checkouts") - - (for-each - (lambda (input-dir) - (let ((elibdir (string-append input-dir %erlang-libdir))) - (when (directory-exists? elibdir) - (for-each - (lambda (dirname) - (symlink (string-append elibdir "/" dirname) - (string-append "_checkouts/" dirname))) - (list-directories elibdir))))) - input-directories) - #t) - -(define* (unpack #:key source #:allow-other-keys) - "Unpack SOURCE in the working directory, and change directory within the -source. When SOURCE is a directory, copy it in a sub-directory of the current -working directory." - ;; archives from hexpm typicalls do not contain a directory level - ;; TODO: Check if archive contains a directory level - (mkdir "source") - (chdir "source") - (if (file-is-directory? source) - (begin - ;; Preserve timestamps (set to the Epoch) on the copied tree so that - ;; things work deterministically. - (copy-recursively source "." - #:keep-mtime? #t)) - (begin - (if (string-suffix? ".zip" source) - (invoke "unzip" source) - (invoke "tar" "xvf" source)))) - #t) - -(define* (build #:key (make-flags '()) (build-target "compile") - #:allow-other-keys) - (apply invoke `("rebar3" ,build-target ,@make-flags))) - -(define* (check #:key target (make-flags '()) (tests? (not target)) - (test-target "eunit") - #:allow-other-keys) - (if tests? - (apply invoke `("rebar3" ,test-target ,@make-flags)) - (format #t "test suite not run~%")) - #t) - -(define (erlang-package? name) - "Check if NAME correspond to the name of an Erlang package." - (string-prefix? "erlang-" name)) - -(define (package-name-version->erlang-name name+ver) - "Convert the Guix package NAME-VER to the corresponding Erlang name-version -format. Essentially drop the prefix used in Guix and replace dashes by -underscores." - (let* ((name- (package-name->name+version name+ver))) - (string-join - (string-split - (if (erlang-package? name-) ; checks for "erlang-" prefix - (string-drop name- (string-length "erlang-")) - name-) - #\-) - "_"))) - -(define (list-directories directory) - "Return file names of the sub-directory of DIRECTORY." - (scandir directory - (lambda (file) - (and (not (member file '("." ".."))) - (file-is-directory? (string-append directory "/" file)))))) - -(define* (install #:key name outputs - (pkg-name (package-name-version->erlang-name name)) - #:allow-other-keys) - (let* ((out (assoc-ref outputs "out")) - (build-dir "_build/default/lib") - (pkg-dir (string-append out %erlang-libdir "/" pkg-name))) - (for-each - (lambda (pkg) - (for-each - (lambda (dirname) - (let ((src-dir (string-append build-dir "/" pkg "/" dirname)) - (dst-dir (string-append pkg-dir "/" dirname))) - (when (file-exists? src-dir) - (copy-recursively src-dir dst-dir #:follow-symlinks? #t)) - (false-if-exception - (delete-file (string-append dst-dir "/.gitignore"))))) - '("ebin" "include" "priv"))) - (list-directories build-dir)) - (false-if-exception - (delete-file (string-append pkg-dir "/priv/Run-eunit-loop.expect"))) - #t)) - -(define %standard-phases - (modify-phases gnu:%standard-phases - (replace 'unpack unpack) - (delete 'bootstrap) - (delete 'configure) - (add-before 'build 'erlang-depends erlang-depends) - (replace 'build build) - (replace 'check check) - (replace 'install install))) - -(define* (rebar3-build #:key inputs (phases %standard-phases) - #:allow-other-keys #:rest args) - "Build the given Erlang package, applying all of PHASES in order." - (apply gnu:gnu-build #:inputs inputs #:phases phases args)) diff --git a/guix/hexpm-download.scm b/guix/hexpm-download.scm deleted file mode 100644 index 25247cb79b..0000000000 --- a/guix/hexpm-download.scm +++ /dev/null @@ -1,76 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès -;;; Copyright © 2017 Mathieu Lirzin -;;; Copyright © 2017 Christopher Baines -;;; Copyright © 2020 Jakub Kądziołka -;;; Copyright © 2020 Hartmut Goebel -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix 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. -;;; -;;; GNU Guix 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 GNU Guix. If not, see . - -(define-module (guix hexpm-download) - #:use-module (ice-9 match) - #:use-module (guix extracting-download) - #:use-module (guix packages) ;; for %current-system - #:use-module (srfi srfi-26) - #:export (hexpm-fetch - - %hexpm-repo-url - hexpm-url - hexpm-url? - hexpm-uri)) - -;;; -;;; An method that fetches a package from the hex.pm repository, -;;; unwrapping the actual content from the download tarball. -;;; - -;; URL and paths from -;; https://github.com/hexpm/specifications/blob/master/endpoints.md -(define %hexpm-repo-url - (make-parameter "https://repo.hex.pm")) -(define hexpm-url - (string-append (%hexpm-repo-url) "/tarballs/")) -(define hexpm-url? - (cut string-prefix? hexpm-url <>)) - -(define (hexpm-uri name version) - "Return a URI string for the package hosted at hex.pm corresponding to NAME -and VERSION." - (string-append hexpm-url name "-" version ".tar")) - -(define* (hexpm-fetch url hash-algo hash - #:optional name - #:key - (filename-to-extract "contents.tar.gz") - (system (%current-system)) - (guile (default-guile))) - "Return a fixed-output derivation that fetches URL and extracts -\"contents.tar.gz\". The output is expected to have hash HASH of type -HASH-ALGO (a symbol). By default, the file name is the base name of URL; -optionally, NAME can specify a different file name. By default, the file name -is the base name of URL with \".gz\" appended; optionally, NAME can specify a -different file name." - (define file-name - (match url - ((head _ ...) - (basename head)) - (_ - (basename url)))) - - (http-fetch/extract url "contents.tar.gz" hash-algo hash - ;; urls typically end with .tar, but contents is .tar.gz - (or name (string-append file-name ".gz")) - #:system system #:guile guile)) diff --git a/guix/import/hexpm.scm b/guix/import/hexpm.scm deleted file mode 100644 index 018732d8c1..0000000000 --- a/guix/import/hexpm.scm +++ /dev/null @@ -1,290 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Cyril Roelandt -;;; Copyright © 2016 David Craven -;;; Copyright © 2017, 2019, 2020 Ludovic Courtès -;;; Copyright © 2019 Martin Becze -;;; Copyright © 2020, 2021 Hartmut Goebel -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix 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. -;;; -;;; GNU Guix 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 GNU Guix. If not, see . - -(define-module (guix import hexpm) - #:use-module (guix base32) - #:use-module ((guix download) #:prefix download:) - #:use-module (guix hexpm-download) - #:use-module (gcrypt hash) - #:use-module (guix http-client) - #:use-module (json) - #:use-module (guix import utils) - #:use-module ((guix import json) #:select (json-fetch)) - #:use-module ((guix build utils) - #:select ((package-name->name+version - . hyphen-package-name->name+version) - dump-port)) - #:use-module ((guix licenses) #:prefix license:) - #:use-module (guix monads) - #:use-module (guix packages) - #:use-module (guix upstream) - #:use-module (guix utils) - #:use-module (ice-9 match) - #:use-module (ice-9 regex) - #:use-module (ice-9 popen) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-2) - #:use-module (srfi srfi-26) - #:export (hexpm->guix-package - guix-package->hexpm-name - strings->licenses - hexpm-recursive-import - %hexpm-updater)) - - -;;; -;;; Interface to https://hex.pm/api, version 2. -;;; https://github.com/hexpm/specifications/blob/master/apiary.apib -;;; https://github.com/hexpm/specifications/blob/master/endpoints.md -;;; - -(define %hexpm-api-url - (make-parameter "https://hex.pm/api")) - -(define (package-url name) - (string-append (%hexpm-api-url) "/packages/" name)) - -;; Hexpm Package. /api/packages/${name} -;; It can have several "releases", each of which has its own set of -;; requirements, buildtool, etc. - see below. -(define-json-mapping make-hexpm-pkgdef hexpm-pkgdef? - json->hexpm - (name hexpm-name) ;string - (html-url hexpm-html-url "html_url") ;string - (docs-html-url hexpm-docs-html-url "docs_html_url") ;string | #nil - (meta hexpm-meta "meta" json->hexpm-meta) - (versions hexpm-versions "releases" ;list of - (lambda (vector) - (map json->hexpm-version - (vector->list vector))))) - -;; Hexpm meta. -(define-json-mapping make-hexpm-meta hexpm-meta? - json->hexpm-meta - (description hexpm-meta-description) ;string - (licenses hexpm-meta-licenses "licenses" ;list of strings - (lambda (vector) - (or (and vector (vector->list vector)) - #f)))) - -;; Hexpm version. -(define-json-mapping make-hexpm-version hexpm-version? - json->hexpm-version - (number hexpm-version-number "version") ;string - (url hexpm-version-url)) ;string - - -(define (lookup-hexpm name) - "Look up NAME on https://hex.pm and return the corresopnding -record or #f if it was not found." - (let ((json (json-fetch (package-url name)))) - (and json - (json->hexpm json)))) - -;; Hexpm release. /api/packages/${name}/releases/${version} -(define-json-mapping make-hexpm-release hexpm-release? - json->hexpm-release - (number hexpm-release-number "version") ;string - (url hexpm-release-url) ;string - (requirements hexpm-requirements "requirements")) ;list of -;; meta:build_tools -> alist - -;; Hexpm dependency. Each dependency (each edge in the graph) is annotated as -;; being a "normal" dependency or a development dependency. There also -;; information about the minimum required version, such as "^0.0.41". -(define-json-mapping make-hexpm-dependency - hexpm-dependency? - json->hexpm-dependency - (app hexpm-dependency-app "app") ;string - (optional hexpm-dependency-optional) ;bool - (requirement hexpm-dependency-requirement)) ;string - -(define (hexpm-release-dependencies release) - "Return the list of dependency names of RELEASE, a ." - (let ((reqs (or (hexpm-requirements release) '#()))) - (map first reqs))) ;; TODO: also return required version - - -(define (lookup-hexpm-release version*) - "Look up RELEASE on hexpm-version-url and return the corresopnding - record or #f if it was not found." - (let* ((url (hexpm-version-url version*)) - (json (json-fetch url))) - (json->hexpm-release json))) - - -;;; -;;; Converting hex.pm packages to Guix packages. -;;; - -(define* (make-hexpm-sexp #:key name version tarball-url - home-page synopsis description license - #:allow-other-keys) - "Return the `package' s-expression for a rust package with the given NAME, -VERSION, tarball-url, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." - (call-with-temporary-directory - (lambda (directory) - (let ((port (http-fetch tarball-url)) - (tar (open-pipe* OPEN_WRITE "tar" "-C" directory - "-xf" "-" "contents.tar.gz"))) - (dump-port port tar) - (close-port port) - - (let ((status (close-pipe tar))) - (unless (zero? status) - (error "tar extraction failure" status)))) - - (let ((guix-name (hexpm-name->package-name name)) - (sha256 (bytevector->nix-base32-string - (call-with-input-file - (string-append directory "/contents.tar.gz") - port-sha256)))) - - `(package - (name ,guix-name) - (version ,version) - (source (origin - (method hexpm-fetch) - (uri (hexpm-uri ,name version)) - (sha256 (base32 ,sha256)))) - (build-system ,'rebar3-build-system) - (home-page ,(match home-page - (() "") - (_ home-page))) - (synopsis ,synopsis) - (description ,(beautify-description description)) - (license ,(match license - (() #f) - ((license) license) - (_ `(list ,@license))))))))) - -(define (strings->licenses strings) - (filter-map (lambda (license) - (and (not (string-null? license)) - (not (any (lambda (elem) (string=? elem license)) - '("AND" "OR" "WITH"))) - (or (spdx-string->license license) - license))) - strings)) - -(define (hexpm-latest-version package) - (let ((versions (map hexpm-version-number (hexpm-versions package)))) - (fold (lambda (a b) - (if (version>? a b) a b)) (car versions) versions))) - -(define* (hexpm->guix-package package-name #:key repo version) - "Fetch the metadata for PACKAGE-NAME from hexpms.io, and return the -`package' s-expression corresponding to that package, or #f on failure. -When VERSION is specified, attempt to fetch that version; otherwise fetch the -latest version of PACKAGE-NAME." - - (define package - (lookup-hexpm package-name)) - - (define version-number - (and package - (or version - (hexpm-latest-version package)))) - - (define version* - (and package - (find (lambda (version) - (string=? (hexpm-version-number version) - version-number)) - (hexpm-versions package)))) - - (define release - (and package version* - (lookup-hexpm-release version*))) - - (and package version* - (let ((dependencies (hexpm-release-dependencies release)) - (pkg-meta (hexpm-meta package))) - (values - (make-hexpm-sexp - #:name package-name - #:version version-number - #:home-page (or (hexpm-docs-html-url package) - ;; TODO: Homepage? - (hexpm-html-url package)) - #:synopsis (hexpm-meta-description pkg-meta) - #:description (hexpm-meta-description pkg-meta) - #:license (or (and=> (hexpm-meta-licenses pkg-meta) - strings->licenses)) - #:tarball-url (hexpm-uri package-name version-number)) - dependencies)))) - -(define* (hexpm-recursive-import pkg-name #:optional version) - (recursive-import pkg-name - #:version version - #:repo->guix-package hexpm->guix-package - #:guix-name hexpm-name->package-name)) - -(define (guix-package->hexpm-name package) - "Return the hex.pm name of PACKAGE." - (define (url->hexpm-name url) - (hyphen-package-name->name+version - (basename (file-sans-extension url)))) - - (match (and=> (package-source package) origin-uri) - ((? string? url) - (url->hexpm-name url)) - ((lst ...) - (any url->hexpm-name lst)) - (#f #f))) - -(define (hexpm-name->package-name name) - (string-append "erlang-" (string-join (string-split name #\_) "-"))) - - -;;; -;;; Updater -;;; - -(define (hexpm-package? package) - "Return true if PACKAGE is a package from hex.pm." - (let ((source-url (and=> (package-source package) origin-uri)) - (fetch-method (and=> (package-source package) origin-method))) - (and (eq? fetch-method hexpm-fetch) - (match source-url - ((? string?) - (hexpm-url? source-url)) - ((source-url ...) - (any hexpm-url? source-url)))))) - -(define (latest-release package) - "Return an for the latest release of PACKAGE." - (let* ((hexpm-name (guix-package->hexpm-name package)) - (hexpm (lookup-hexpm hexpm-name)) - (version (hexpm-latest-version hexpm)) - (url (hexpm-uri hexpm-name version))) - (upstream-source - (package (package-name package)) - (version version) - (urls (list url))))) - -(define %hexpm-updater - (upstream-updater - (name 'hexpm) - (description "Updater for hex.pm packages") - (pred hexpm-package?) - (latest latest-release))) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index aaad247c63..a180742ca3 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -359,7 +359,6 @@ (define (source-spec->object source) ("git-fetch" (@ (guix git-download) git-fetch)) ("svn-fetch" (@ (guix svn-download) svn-fetch)) ("hg-fetch" (@ (guix hg-download) hg-fetch)) - ("hexpm-fetch" (@ (guix hexpm-download) hexpm-fetch)) (_ #f))) (uri (assoc-ref orig "uri")) (sha256 sha)))))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index aaadad4adf..40fa6759ae 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -79,7 +79,7 @@ (define %standard-import-options '()) ;;; (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" - "gem" "go" "cran" "crate" "texlive" "json" "opam" "hexpm" + "gem" "go" "cran" "crate" "texlive" "json" "opam" "minetest")) (define (resolve-importer name) diff --git a/guix/scripts/import/hexpm.scm b/guix/scripts/import/hexpm.scm deleted file mode 100644 index 95a291f1a8..0000000000 --- a/guix/scripts/import/hexpm.scm +++ /dev/null @@ -1,114 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 David Thompson -;;; Copyright © 2016 David Craven -;;; Copyright © 2019 Martin Becze -;;; Copyright © 2020 Hartmut Goebel -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix 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. -;;; -;;; GNU Guix 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 GNU Guix. If not, see . - -(define-module (guix scripts import hexpm) - #:use-module (guix ui) - #:use-module (guix utils) - #:use-module (guix scripts) - #:use-module (guix import hexpm) - #:use-module (guix scripts import) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-37) - #:use-module (ice-9 match) - #:use-module (ice-9 format) - #:export (guix-import-hexpm)) - - -;;; -;;; Command-line options. -;;; - -(define %default-options - '()) - -(define (show-help) - (display (G_ "Usage: guix import hexpm PACKAGE-NAME -Import and convert the hex.pm package for PACKAGE-NAME.\n")) - (display (G_ " - -r, --recursive import packages recursively")) - (newline) - (display (G_ " - -h, --help display this help and exit")) - (display (G_ " - -V, --version display version information and exit")) - (newline) - (show-bug-report-information)) - -(define %options - ;; Specification of the command-line options. - (cons* (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix import hexpm"))) - (option '(#\r "recursive") #f #f - (lambda (opt name arg result) - (alist-cons 'recursive #t result))) - %standard-import-options)) - - -;;; -;;; Entry point. -;;; - -(define (guix-import-hexpm . args) - (define (parse-options) - ;; Return the alist of option values. - (args-fold* args %options - (lambda (opt name arg result) - (leave (G_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (alist-cons 'argument arg result)) - %default-options)) - - - (let* ((opts (parse-options)) - (args (filter-map (match-lambda - (('argument . value) - value) - (_ #f)) - (reverse opts)))) - (match args - ((spec) - (define-values (name version) - (package-name->name+version spec)) - - (if (assoc-ref opts 'recursive) - (map (match-lambda - ((and ('package ('name name) . rest) pkg) - `(define-public ,(string->symbol name) - ,pkg)) - (_ #f)) - (hexpm-recursive-import name version)) - (let ((sexp (hexpm->guix-package name #:version version))) - (unless sexp - (leave (G_ "failed to download meta-data for package '~a'~%") - (if version - (string-append name "@" version) - name))) - sexp))) - (() - (leave (G_ "too few arguments~%"))) - ((many ...) - (leave (G_ "too many arguments~%")))))) diff --git a/guix/upstream.scm b/guix/upstream.scm index f1fb84eb45..632e9ebc4f 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -24,10 +24,6 @@ (define-module (guix upstream) #:use-module (guix discovery) #:use-module ((guix download) #:select (download-to-store url-fetch)) - #:use-module ((guix hexpm-download) - #:select (hexpm-fetch)) - #:use-module ((guix extracting-download) - #:select (download-to-store/extract)) #:use-module (guix gnupg) #:use-module (guix packages) #:use-module (guix diagnostics) @@ -434,23 +430,9 @@ (define* (package-update/url-fetch store package source #:key-download key-download))) (values version tarball source)))))) -(define* (package-update/hexpm-fetch store package source - #:key key-download) - "Return the version, tarball, and SOURCE, to update PACKAGE to -SOURCE, an ." - (match source - (($ _ version urls signature-urls) - (let* ((url (first urls)) - (name (or (origin-file-name (package-source package)) - (string-append (basename url) ".gz"))) - (tarball (download-to-store/extract - store url "contents.tar.gz" name))) - (values version tarball source))))) - (define %method-updates ;; Mapping of origin methods to source update procedures. - `((,url-fetch . ,package-update/url-fetch) - (,hexpm-fetch . ,package-update/hexpm-fetch))) + `((,url-fetch . ,package-update/url-fetch))) (define* (package-update store package #:optional (updaters (force %updaters)) -- cgit v1.2.3