From 59ee10754eddddb99e4a80b9e18aa12ed1b3d77a Mon Sep 17 00:00:00 2001 From: Xinglu Chen Date: Fri, 17 Sep 2021 10:04:49 +0200 Subject: import: Add 'generic-git' updater. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/git.scm (ls-remote-refs): New procedure. * tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests. * guix/import/git.scm: New file. * doc/guix.texi (Invoking guix refresh): Document it. * tests/import-git.scm: New test file. * Makefile.am (MODULES, SCM_TESTS): Register the new files. Co-authored-by: Sarah Morgensen Signed-off-by: Ludovic Courtès --- guix/import/git.scm | 225 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 225 insertions(+) create mode 100644 guix/import/git.scm (limited to 'guix/import') diff --git a/guix/import/git.scm b/guix/import/git.scm new file mode 100644 index 0000000000..1eb219f3fe --- /dev/null +++ b/guix/import/git.scm @@ -0,0 +1,225 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2021 Sarah Morgensen +;;; +;;; 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 git) + #:use-module (guix build utils) + #:use-module (guix diagnostics) + #:use-module (guix git) + #:use-module (guix git-download) + #:use-module (guix i18n) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module (guix utils) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:export (%generic-git-updater + + ;; For tests. + latest-git-tag-version)) + +;;; Commentary: +;;; +;;; This module provides a generic package updater for packages hosted on Git +;;; repositories. +;;; +;;; It tries to be smart about tag names, but if it is not automatically able +;;; to parse the tag names correctly, users can set the `release-tag-prefix', +;;; `release-tag-suffix' and `release-tag-version-delimiter' properties of the +;;; package to make the updater parse the Git tag name correctly. +;;; +;;; Possible improvements: +;;; +;;; * More robust method for trying to guess the delimiter. Maybe look at the +;;; previous version/tag combo to determine the delimiter. +;;; +;;; * Differentiate between "normal" versions, e.g., 1.2.3, and dates, e.g., +;;; 2021.12.31. Honor a `release-tag-date-scheme?' property? +;;; +;;; Code: + +;;; Errors & warnings + +(define-condition-type &git-no-valid-tags-error &error + git-no-valid-tags-error?) + +(define (git-no-valid-tags-error) + (raise (condition (&message (message "no valid tags found")) + (&git-no-valid-tags-error)))) + +(define-condition-type &git-no-tags-error &error + git-no-tags-error?) + +(define (git-no-tags-error) + (raise (condition (&message (message "no tags were found")) + (&git-no-tags-error)))) + + +;;; Updater + +(define %pre-release-words + '("alpha" "beta" "rc" "dev" "test" "pre")) + +(define %pre-release-rx + (map (lambda (word) + (make-regexp (string-append ".+" word) regexp/icase)) + %pre-release-words)) + +(define* (version-mapping tags #:key prefix suffix delim pre-releases?) + "Given a list of Git TAGS, return an association list where the car is the +version corresponding to the tag, and the cdr is the name of the tag." + (define (guess-delimiter) + (let ((total (length tags)) + (dots (reduce + 0 (map (cut string-count <> #\.) tags))) + (dashes (reduce + 0 (map (cut string-count <> #\-) tags))) + (underscores (reduce + 0 (map (cut string-count <> #\_) tags)))) + (cond + ((>= dots (* total 0.35)) ".") + ((>= dashes (* total 0.8)) "-") + ((>= underscores (* total 0.8)) "_") + (else "")))) + + (define delim-rx (regexp-quote (or delim (guess-delimiter)))) + (define suffix-rx (string-append (or suffix "") "$")) + (define prefix-rx (string-append "^" (or prefix "[^[:digit:]]*"))) + (define pre-release-rx + (if pre-releases? + (string-append "(.*(" (string-join %pre-release-words "|") ").*)") + "")) + + (define tag-rx + (string-append prefix-rx "([[:digit:]][^" delim-rx "[:punct:]]*" + "(" delim-rx "[^[:punct:]" delim-rx "]+)" + ;; If there are no delimiters, it could mean that the + ;; version just contains one number (e.g., "2"), thus, use + ;; "*" instead of "+" to match zero or more numbers. + (if (string=? delim-rx "") "*" "+") ")" + ;; We don't want the pre-release stuff (e.g., "-alpha") be + ;; part of the first group; otherwise, the "-" in "-alpha" + ;; might be interpreted as a delimiter, and thus replaced + ;; with "." + pre-release-rx suffix-rx)) + + + + (define (get-version tag) + (let ((tag-match (regexp-exec (make-regexp tag-rx) tag))) + (and=> (and tag-match + (regexp-substitute/global + #f delim-rx (match:substring tag-match 1) + ;; If there were no delimiters, don't insert ".". + 'pre (if (string=? delim-rx "") "" ".") 'post)) + (lambda (version) + (if pre-releases? + (string-append version (match:substring tag-match 3)) + version))))) + + (define (entry tag) + %pre-release-rx)) + + (let* ((tags (map (cut string-drop <> (string-length "refs/tags/")) + (remote-refs url #:tags? #t))) + (versions->tags + (version-mapping (if pre-releases? + tags + (filter (negate pre-release?) tags)) + #:prefix prefix + #:suffix suffix + #:delim delim + #:pre-releases? pre-releases?))) + (cond + ((null? tags) + (git-no-tags-error)) + ((null? versions->tags) + (git-no-valid-tags-error)) + (else + (match (last versions->tags) + ((version . tag) + (values version tag))))))) + +(define (latest-git-tag-version package) + "Given a PACKAGE, return the latest version of it, or #f if the latest version +could not be determined." + (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c)) + (warning (or (package-field-location package 'source) + (package-location package)) + (G_ "~a for ~a~%") + (condition-message c) + (package-name package)) + #f) + ((eq? (exception-kind c) 'git-error) + (warning (or (package-field-location package 'source) + (package-location package)) + (G_ "failed to fetch Git repository for ~a~%") + (package-name package)) + #f)) + (let* ((source (package-source package)) + (url (git-reference-url (origin-uri source))) + (property (cute assq-ref (package-properties package) <>))) + (latest-tag url + #:prefix (property 'release-tag-prefix) + #:suffix (property 'release-tag-suffix) + #:delim (property 'release-tag-version-delimiter) + #:pre-releases? (property 'accept-pre-releases?))))) + +(define (git-package? package) + "Return true if PACKAGE is hosted on a Git repository." + (match (package-source package) + ((? origin? origin) + (and (eq? (origin-method origin) git-fetch) + (git-reference? (origin-uri origin)))) + (_ #f))) + +(define (latest-git-release package) + "Return an for the latest release of PACKAGE." + (let* ((name (package-name package)) + (old-version (package-version package)) + (url (git-reference-url (origin-uri (package-source package)))) + (new-version (latest-git-tag-version package))) + + (and new-version + (upstream-source + (package name) + (version new-version) + (urls (list url)))))) + +(define %generic-git-updater + (upstream-updater + (name 'generic-git) + (description "Updater for packages hosted on Git repositories") + (pred git-package?) + (latest latest-git-release))) -- cgit v1.2.3 From 8480a2a5bb360b432877dd33dca80a61c5a698eb Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 7 Sep 2021 13:05:56 +0200 Subject: import: minetest: Delete duplicate dependencies. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This fixes one of the issues noted in . * guix/import/minetest.scm (import-dependencies): Call 'delete-duplicates' on the resulting list. * tests/minetest.scm ("minetest->guix-package, multiple dependencies implemented by one mod"): New test. Signed-off-by: Ludovic Courtès --- guix/import/minetest.scm | 6 +++++- tests/minetest.scm | 10 ++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) (limited to 'guix/import') diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm index e1f8487b75..c8209aba79 100644 --- a/guix/import/minetest.scm +++ b/guix/import/minetest.scm @@ -371,7 +371,11 @@ (define* (important-dependencies dependencies author/name DEPENDENCIES as a list of AUTHOR/NAME strings." (define dependency-list (assoc-ref dependencies author/name)) - (filter-map + ;; A mod can have multiple dependencies implemented by the same mod, + ;; so remove duplicate mod names. + (define (filter-deduplicate-map f list) + (delete-duplicates (filter-map f list))) + (filter-deduplicate-map (lambda (dependency) (and (not (dependency-optional? dependency)) (not (builtin-mod? (dependency-name dependency))) diff --git a/tests/minetest.scm b/tests/minetest.scm index c6e872e918..80e2697a3d 100644 --- a/tests/minetest.scm +++ b/tests/minetest.scm @@ -331,6 +331,16 @@ (define-syntax-rule (test-package* test-case primary-arguments extra-arguments "some-modpack/containing-mese"))) #:inputs '()) +;; See e.g. 'orwell/basic_trains' +(test-package* "minetest->guix-package, multiple dependencies implemented by one mod" + (list #:name "frobnicate" + #:guix-name "minetest-frobnicate" + #:upstream-name "Author/frobnicate" + #:requirements '(("frob" #f ("Author/frob")) + ("frob_x" #f ("Author/frob"))) + #:inputs '("minetest-frob")) + (list #:author "Author" #:name "frob")) + ;; License (test-package "minetest->guix-package, identical licenses" -- cgit v1.2.3 From 808f9ffbd3106da4c92d2367b118b98196c9e81e Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 7 Sep 2021 13:24:24 +0200 Subject: import: minetest: Strip "v" prefixes from the version number. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This fixes one of the issues noted at . * guix/import/minetest.scm (release-version): New procedure. (%minetest->guix-package): Call new procedure instead of release-title. * tests/minetest.scm (make-package-sexp): Allow overriding the version number. (make-releases-json): Allow overriding the release title. ("conventional version number") ("v-prefixed version number") ("dates as version number"): New tests. Signed-off-by: Ludovic Courtès --- guix/import/minetest.scm | 10 +++++++++- tests/minetest.scm | 23 ++++++++++++++++++----- 2 files changed, 27 insertions(+), 6 deletions(-) (limited to 'guix/import') diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm index c8209aba79..29bf12d123 100644 --- a/guix/import/minetest.scm +++ b/guix/import/minetest.scm @@ -337,6 +337,14 @@ (define (topic->url-sexp topic) (and=> (package-forums package) topic->url-sexp) (package-repository package))) +(define (release-version release) + "Guess the version of RELEASE from the release title." + (define title (release-title release)) + (if (string-prefix? "v" title) + ;; Remove "v" prefix from release titles like ‘v1.0.1’. + (substring title 1) + title)) + ;; If the default sort key is changed, make sure to modify 'show-help' ;; in (guix scripts import minetest) appropriately as well. (define %default-sort-key "score") @@ -436,7 +444,7 @@ (define release (latest-release author/name)) (define important-upstream-dependencies (important-dependencies dependencies author/name #:sort sort)) (values (make-minetest-sexp author/name - (release-title release) ; version + (release-version release) (package-repository package) (release-commit release) important-upstream-dependencies diff --git a/tests/minetest.scm b/tests/minetest.scm index 80e2697a3d..6998c9a70b 100644 --- a/tests/minetest.scm +++ b/tests/minetest.scm @@ -33,6 +33,10 @@ (define-module (test-minetest) (define* (make-package-sexp #:key (guix-name "minetest-foo") + ;; This is not a proper version number but + ;; ContentDB often does not include version + ;; numbers. + (version "2021-07-25") (home-page "https://example.org/foo") (repo "https://example.org/foo.git") (synopsis "synopsis") @@ -44,9 +48,7 @@ (define* (make-package-sexp #:key #:allow-other-keys) `(package (name ,guix-name) - ;; This is not a proper version number but ContentDB does not include - ;; version numbers. - (version "2021-07-25") + (version ,version) (source (origin (method git-fetch) @@ -106,14 +108,14 @@ (define* (make-package-json #:key author "/" name "/download/")) ("website" . ,website))) -(define* (make-releases-json #:key (commit #f) (title "") #:allow-other-keys) +(define* (make-releases-json #:key (commit #f) (title "2021-07-25") #:allow-other-keys) `#((("commit" . ,commit) ("downloads" . 469) ("id" . 8614) ("max_minetest_version" . null) ("min_minetest_version" . null) ("release_date" . "2021-07-25T01:10:23.207584") - ("title" . "2021-07-25")))) + ("title" . ,title)))) (define* (make-dependencies-json #:key (author "Author") (name "foo") @@ -292,6 +294,17 @@ (define-syntax-rule (test-package* test-case primary-arguments extra-arguments #:website 'null #:repo 'null) + +;; Determining the version number + +(test-package "conventional version number" #:version "1.2.3" #:title "1.2.3") +;; See e.g. orwell/basic_trains +(test-package "v-prefixed version number" #:version "1.2.3" #:title "v1.2.3") +;; Many mods on ContentDB use dates as release titles. In that case, the date +;; will have to do. +(test-package "dates as version number" + #:version "2021-01-01" #:title "2021-01-01") + ;; Dependencies -- cgit v1.2.3 From b3907e304d6e66fbd3cffd71446ac8c46d26d849 Mon Sep 17 00:00:00 2001 From: Sarah Morgensen Date: Thu, 16 Sep 2021 18:24:40 -0700 Subject: import: go: Improve handling of modules in VCS subdirectories. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Use the supplied module path (instead of the repository root) as the import path for everything except source and homepage URLs. For modules not in the root of a VCS repository, set #:unpack-path to the repository root by default. Partly fixes . Reported by Stephen Paul Weber . * guix/import/go.scm (go-module->guix-package): Use 'module-path' instead of 'root-module-path' for #:import-path. Emit #:unpack-path when #:import-path is not equal to 'root-module-path'. Signed-off-by: Ludovic Courtès --- guix/import/go.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'guix/import') diff --git a/guix/import/go.scm b/guix/import/go.scm index c6ecdbaffd..fe7387dec2 100644 --- a/guix/import/go.scm +++ b/guix/import/go.scm @@ -619,7 +619,7 @@ (define* (go-module->guix-package module-path #:key (meta-data (fetch-module-meta-data root-module-path)) (vcs-type (module-meta-vcs meta-data)) (vcs-repo-url (module-meta-data-repo-url meta-data goproxy)) - (synopsis (go-package-synopsis root-module-path)) + (synopsis (go-package-synopsis module-path)) (description (go-package-description module-path)) (licenses (go-package-licenses module-path))) (values @@ -630,7 +630,10 @@ (define* (go-module->guix-package module-path #:key ,(vcs->origin vcs-type vcs-repo-url version*)) (build-system go-build-system) (arguments - '(#:import-path ,root-module-path)) + '(#:import-path ,module-path + ,@(if (string=? module-path root-module-path) + '() + `(#:unpack-path ,root-module-path)))) ,@(maybe-propagated-inputs (map (match-lambda ((name version) -- cgit v1.2.3 From 281ede2e7db73fa0632b80c084bce9611962b353 Mon Sep 17 00:00:00 2001 From: Sarah Morgensen Date: Thu, 16 Sep 2021 18:27:09 -0700 Subject: import: go: Match "go-import" meta tags anywhere. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Some personal sites forget to put in a element, so look anywhere for them. Partly fixes . Reported by Stephen Paul Weber . * guix/import/go.scm (fetch-module-meta-data): Match "go-import" meta tags anywhere in the page. Signed-off-by: Ludovic Courtès --- guix/import/go.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/import') diff --git a/guix/import/go.scm b/guix/import/go.scm index fe7387dec2..9769b557ae 100644 --- a/guix/import/go.scm +++ b/guix/import/go.scm @@ -480,7 +480,7 @@ (define (go-import->module-meta content-text) (strip-.git-suffix/maybe repo-url))))) ;; (let* ((meta-data (http-fetch* (format #f "https://~a?go-get=1" module-path))) - (select (sxpath `(// head (meta (@ (equal? (name "go-import")))) + (select (sxpath `(// (meta (@ (equal? (name "go-import")))) // content)))) (match (select (html->sxml meta-data #:strict? #t)) (() #f) ;nothing selected -- cgit v1.2.3 From 9c5e5ca1c0de56a0d5b2b924de10548172095b58 Mon Sep 17 00:00:00 2001 From: Xinglu Chen Date: Thu, 16 Sep 2021 13:29:42 +0200 Subject: import: stackage: Don’t try to update packages not available on Stackage. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previously, the ‘hackage-package?’ predicate was used which meant that the updater would try to update non-Stackage packages, and lead to messages like these: $ guix refresh -t stackage warning: failed to parse https://hackage.haskell.org/package/hurl/hurl.cabal warning: failed to parse https://hackage.haskell.org/package/idris/idris.cabal Since ‘hurl’ and ‘idris’ aren’t available on the current Stackage LTS release, they should be filtered out before the Stackage updater even tries to update them. * stackage.scm (stackage-package?): New procedure. (%stackage-updater): Use it. Signed-off-by: Lars-Dominik Braun --- guix/import/stackage.scm | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) (limited to 'guix/import') diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index bbd903a2cd..731e69651e 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017 Federico Beffa ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2020 Martin Becze +;;; Copyright © 2021 Xinglu Chem ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,10 +22,12 @@ (define-module (guix import stackage) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (ice-9 control) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-43) #:use-module (guix import json) #:use-module (guix import hackage) #:use-module (guix import utils) @@ -141,11 +144,23 @@ (define latest-lts-release (version version) (urls (list url)))))))))) +(define (stackage-package? package) + "Whether PACKAGE is available on the default Stackage LTS release." + (and (hackage-package? package) + (let ((packages (lts-info-packages + (stackage-lts-info-fetch %default-lts-version))) + (hackage-name (guix-package->hackage-name package))) + (vector-any identity + (vector-map + (lambda (_ metadata) + (string=? (cdr (list-ref metadata 2)) hackage-name)) + packages))))) + (define %stackage-updater (upstream-updater (name 'stackage) (description "Updater for Stackage LTS packages") - (pred hackage-package?) + (pred stackage-package?) (latest latest-lts-release))) ;;; stackage.scm ends here -- cgit v1.2.3 From 2f5368d678aad334149b280e9dab90ec1635104b Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Mon, 27 Sep 2021 16:06:31 +0200 Subject: import: minetest: Fix typos. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/import/minetest.scm (elaborate-contentdb-name): Fix ‘ambiguous’ and ‘thes’ typos. * tests/minetest.scm: Likewise for all tests. --- guix/import/minetest.scm | 4 ++-- tests/minetest.scm | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) (limited to 'guix/import') diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm index 29bf12d123..ba86c60bfd 100644 --- a/guix/import/minetest.scm +++ b/guix/import/minetest.scm @@ -203,7 +203,7 @@ (define* (elaborate-contentdb-name name #:key (sort %default-sort-key)) (match correctly-named ((one) (package-keys-full-name one)) ((too . many) - (warning (G_ "~a is ambigious, presuming ~a (other options include: ~a)~%") + (warning (G_ "~a is ambiguous, presuming ~a (other options include: ~a)~%") name (package-keys-full-name too) (map package-keys-full-name many)) (package-keys-full-name too)) @@ -256,7 +256,7 @@ (define* (contentdb-query-packages q #:key (order "desc")) "Search ContentDB for Q (a string). Sort by SORT, in ascending order if ORDER is \"asc\" or descending order if ORDER is \"desc\". TYPE must -be \"mod\", \"game\" or \"txp\", restricting thes search results to +be \"mod\", \"game\" or \"txp\", restricting the search results to respectively mods, games and texture packs. Limit to at most LIMIT results. The return value is a list of records." ;; XXX does Guile have something for constructing (and, when necessary, diff --git a/tests/minetest.scm b/tests/minetest.scm index 6998c9a70b..abb26d0a03 100644 --- a/tests/minetest.scm +++ b/tests/minetest.scm @@ -249,14 +249,14 @@ (define-syntax-rule (test-package* test-case primary-arguments extra-arguments #:guix-name "minetest-foo-bar" #:upstream-name "Author/foo_bar") -(test-equal "elaborate names, unambigious" +(test-equal "elaborate names, unambiguous" "Jeija/mesecons" (call-with-packages (cut elaborate-contentdb-name "mesecons") '(#:name "mesecons" #:author "Jeija") '(#:name "something" #:author "else"))) -(test-equal "elaborate name, ambigious (highest score)" +(test-equal "elaborate name, ambiguous (highest score)" "Jeija/mesecons" (call-with-packages ;; #:sort "score" is the default @@ -266,7 +266,7 @@ (define-syntax-rule (test-package* test-case primary-arguments extra-arguments '(#:name "mesecons" #:author "Jeija" #:score 999))) -(test-equal "elaborate name, ambigious (most downloads)" +(test-equal "elaborate name, ambiguous (most downloads)" "Jeija/mesecons" (call-with-packages (cut elaborate-contentdb-name "mesecons" #:sort "downloads") @@ -308,7 +308,7 @@ (define-syntax-rule (test-package* test-case primary-arguments extra-arguments ;; Dependencies -(test-package* "minetest->guix-package, unambigious dependency" +(test-package* "minetest->guix-package, unambiguous dependency" (list #:requirements '(("mesecons" #f ("Jeija/mesecons" "some-modpack/containing-mese"))) @@ -316,7 +316,7 @@ (define-syntax-rule (test-package* test-case primary-arguments extra-arguments (list #:author "Jeija" #:name "mesecons") (list #:author "some-modpack" #:name "containing-mese" #:type "modpack")) -(test-package* "minetest->guix-package, ambigious dependency (highest score)" +(test-package* "minetest->guix-package, ambiguous dependency (highest score)" (list #:name "frobnicate" #:guix-name "minetest-frobnicate" #:upstream-name "Author/frobnicate" @@ -327,7 +327,7 @@ (define-syntax-rule (test-package* test-case primary-arguments extra-arguments (list #:author "Author" #:name "foo" #:score 0) (list #:author "Author" #:name "bar" #:score 9999)) -(test-package* "minetest->guix-package, ambigious dependency (most downloads)" +(test-package* "minetest->guix-package, ambiguous dependency (most downloads)" (list #:name "frobnicate" #:guix-name "minetest-frobnicate" #:upstream-name "Author/frobnicate" -- cgit v1.2.3 From 7b75f90c5b0da896c486cae23d19d43e2a03bb56 Mon Sep 17 00:00:00 2001 From: Xinglu Chen Date: Mon, 27 Sep 2021 22:11:20 +0200 Subject: import: pypi: Honor the 'upstream-name' package property. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previously, when a PyPI package had a “-” followed by one or more digits in its name, e.g., “AV-98”, the importer would interpret “98” as the version of the package and thus mistake the “AV-98” package for the “av” package on PyPI. $ ./pre-inst-env guix refresh av-98 following redirection to `https://pypi.org/pypi/av/json'... /home/yoctocell/src/guix/gnu/packages/web-browsers.scm:914:13: av-98 would be upgraded from 1.0.1 to 8.0.3 Setting the ‘upstream-name’ property to “AV-98” would solve the problem. $ ./pre-inst-env guix refresh av-98 /home/yoctocell/src/guix/gnu/packages/web-browsers.scm:914:13: 1.0.1 is already the latest version of av-98 * guix/import/pypi.scm (guix-package->pypi-name): Honor ‘upstream-name’ property. (make-pypi-sexp): Set ‘upstream-name’ property when appropriate. * tests/pypi.scm (test-json): Rename to ... (test-json-1): ... this. (test-json-2): New variable ("guix-package->pypi-name, honor 'upstream-name'"): New test. ("pypi->guix-package, package name contains \"-\" followed by digits"): Likewise. Signed-off-by: Ludovic Courtès --- guix/import/pypi.scm | 20 +++++++--- tests/pypi.scm | 106 +++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 113 insertions(+), 13 deletions(-) (limited to 'guix/import') diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 6731d50891..b7859c8341 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2020 Lars-Dominik Braun ;;; Copyright © 2020 Arun Isaac ;;; Copyright © 2020 Martin Becze +;;; Copyright © 2021 Xinglu Chen ;;; ;;; This file is part of GNU Guix. ;;; @@ -163,12 +164,13 @@ (define (url->pypi-name url) (hyphen-package-name->name+version (basename (file-sans-extension url)))) - (match (and=> (package-source package) origin-uri) - ((? string? url) - (url->pypi-name url)) - ((lst ...) - (any url->pypi-name lst)) - (#f #f))) + (or (assoc-ref (package-properties package) 'upstream-name) + (match (and=> (package-source package) origin-uri) + ((? string? url) + (url->pypi-name url)) + ((lst ...) + (any url->pypi-name lst)) + (#f #f)))) (define (wheel-url->extracted-directory wheel-url) (match (string-split (basename wheel-url) #\-) @@ -423,6 +425,11 @@ (define (make-pypi-sexp name version source-url wheel-url home-page synopsis description license) "Return the `package' s-expression for a python package with the given NAME, VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." + (define (maybe-upstream-name name) + (if (string-match ".*\\-[0-9]+" (pk name)) + `((properties ,`'(("upstream-name" . ,name)))) + '())) + (call-with-temporary-output-file (lambda (temp port) (and (url-fetch source-url temp) @@ -461,6 +468,7 @@ (define (make-pypi-sexp name version source-url wheel-url home-page synopsis (sha256 (base32 ,(guix-hash-url temp))))) + ,@(maybe-upstream-name name) (build-system python-build-system) ,@(maybe-inputs required-inputs 'propagated-inputs) ,@(maybe-inputs native-inputs 'native-inputs) diff --git a/tests/pypi.scm b/tests/pypi.scm index f421d6d9df..70f4298a90 100644 --- a/tests/pypi.scm +++ b/tests/pypi.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson ;;; Copyright © 2016 Ricardo Wurmus ;;; Copyright © 2019 Maxim Cournoyer +;;; Copyright © 2021 Xinglu Chen ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,7 +30,7 @@ (define-module (test-pypi) #:use-module (srfi srfi-64) #:use-module (ice-9 match)) -(define test-json +(define test-json-1 "{ \"info\": { \"version\": \"1.0.0\", @@ -57,6 +58,34 @@ (define test-json } }") +(define test-json-2 + "{ + \"info\": { + \"version\": \"1.0.0\", + \"name\": \"foo-99\", + \"license\": \"GNU LGPL\", + \"summary\": \"summary\", + \"home_page\": \"http://example.com\", + \"classifiers\": [], + \"download_url\": \"\" + }, + \"urls\": [], + \"releases\": { + \"1.0.0\": [ + { + \"url\": \"https://example.com/foo-99-1.0.0.egg\", + \"packagetype\": \"bdist_egg\" + }, { + \"url\": \"https://example.com/foo-99-1.0.0.tar.gz\", + \"packagetype\": \"sdist\" + }, { + \"url\": \"https://example.com/foo-99-1.0.0-py2.py3-none-any.whl\", + \"packagetype\": \"bdist_wheel\" + } + ] + } +}") + (define test-source-hash "") @@ -147,6 +176,13 @@ (define test-metadata-with-extras-jedi "\ (uri (list "https://bitheap.org/cram/cram-0.7.tar.gz" (pypi-uri "cram" "0.7")))))))) +(test-equal "guix-package->pypi-name, honor 'upstream-name'" + "bar-3" + (guix-package->pypi-name + (dummy-package "foo" + (properties + '((upstream-name . "bar-3")))))) + (test-equal "specification->requirement-name" '("Fizzy" "PickyThing" "SomethingWithMarker" "requests" "pip") (map specification->requirement-name test-specifications)) @@ -198,8 +234,8 @@ (define test-metadata-with-extras-jedi "\ (lambda (url . rest) (match url ("https://pypi.org/pypi/foo/json" - (values (open-input-string test-json) - (string-length test-json))) + (values (open-input-string test-json-1) + (string-length test-json-1))) ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) (_ (error "Unexpected URL: " url))))) (match (pypi->guix-package "foo") @@ -264,8 +300,8 @@ (define test-metadata-with-extras-jedi "\ (lambda (url . rest) (match url ("https://pypi.org/pypi/foo/json" - (values (open-input-string test-json) - (string-length test-json))) + (values (open-input-string test-json-1) + (string-length test-json-1))) ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) (_ (error "Unexpected URL: " url))))) ;; Not clearing the memoization cache here would mean returning the value @@ -317,8 +353,8 @@ (define test-metadata-with-extras-jedi "\ (lambda (url . rest) (match url ("https://pypi.org/pypi/foo/json" - (values (open-input-string test-json) - (string-length test-json))) + (values (open-input-string test-json-1) + (string-length test-json-1))) ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) (_ (error "Unexpected URL: " url))))) ;; Not clearing the memoization cache here would mean returning the value @@ -345,4 +381,60 @@ (define test-metadata-with-extras-jedi "\ (x (pk 'fail x #f)))))) +(test-assert "pypi->guix-package, package name contains \"-\" followed by digits" + ;; Replace network resources with sample data. + (mock ((guix import utils) url-fetch + (lambda (url file-name) + (match url + ("https://example.com/foo-99-1.0.0.tar.gz" + (begin + ;; Unusual requires.txt location should still be found. + (mkdir-p "foo-99-1.0.0/src/bizarre.egg-info") + (with-output-to-file "foo-99-1.0.0/src/bizarre.egg-info/requires.txt" + (lambda () + (display test-requires.txt))) + (parameterize ((current-output-port (%make-void-port "rw+"))) + (system* "tar" "czvf" file-name "foo-99-1.0.0/")) + (delete-file-recursively "foo-99-1.0.0") + (set! test-source-hash + (call-with-input-file file-name port-sha256)))) + ("https://example.com/foo-99-1.0.0-py2.py3-none-any.whl" #f) + (_ (error "Unexpected URL: " url))))) + (mock ((guix http-client) http-fetch + (lambda (url . rest) + (match url + ("https://pypi.org/pypi/foo-99/json" + (values (open-input-string test-json-2) + (string-length test-json-2))) + ("https://example.com/foo-99-1.0.0-py2.py3-none-any.whl" #f) + (_ (error "Unexpected URL: " url))))) + (match (pypi->guix-package "foo-99") + (('package + ('name "python-foo-99") + ('version "1.0.0") + ('source ('origin + ('method 'url-fetch) + ('uri ('pypi-uri "foo-99" 'version)) + ('sha256 + ('base32 + (? string? hash))))) + ('properties ('quote (("upstream-name" . "foo-99")))) + ('build-system 'python-build-system) + ('propagated-inputs + ('quasiquote + (("python-bar" ('unquote 'python-bar)) + ("python-foo" ('unquote 'python-foo))))) + ('native-inputs + ('quasiquote + (("python-pytest" ('unquote 'python-pytest))))) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license 'license:lgpl2.0)) + (string=? (bytevector->nix-base32-string + test-source-hash) + hash)) + (x + (pk 'fail x #f)))))) + (test-end "pypi") -- cgit v1.2.3 From 46d15af4cb913d135c6e16c8cb713058aa9e2691 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 30 Sep 2021 22:38:57 +0200 Subject: import: stackage: Use 'define-json-mapping'. * guix/import/stackage.scm (, ) (): New record types and JSON mappings. (lts-info-packages, stackage-package-name) (stackage-package-version): Remove. (lts-package-version): Rename 'pkgs-info' to 'packages'; assume 'packages' is a list of . (stackage->guix-package): Use 'stackage-lts-packages' instead of 'lts-info-packages'. Rename 'packages-info' to 'packages'. (latest-lts-release): Likewise. (stackage-package?): Rename to... (stackage-lts-package?): ... this. Adjust to new API. (%stackage-updater)[pred]: Update accordingly. * tests/lint.scm ("haskell-stackage"): Add "snapshot" entry in JSON snippet. --- guix/import/stackage.scm | 79 +++++++++++++++++++++++++++--------------------- tests/lint.scm | 6 +++- 2 files changed, 49 insertions(+), 36 deletions(-) (limited to 'guix/import') diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 731e69651e..4eff09ad01 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2020 Martin Becze ;;; Copyright © 2021 Xinglu Chem +;;; Copyright © 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,13 +22,10 @@ (define-module (guix import stackage) #:use-module (ice-9 match) - #:use-module (ice-9 regex) - #:use-module (ice-9 control) + #:use-module (json) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) - #:use-module (srfi srfi-43) #:use-module (guix import json) #:use-module (guix import hackage) #:use-module (guix import utils) @@ -50,9 +48,28 @@ (define %stackage-url ;; Latest LTS version compatible with GHC 8.6.5. (define %default-lts-version "14.27") -(define (lts-info-packages lts-info) - "Returns the alist of packages contained in LTS-INFO." - (or (assoc-ref lts-info "packages") '())) +(define-json-mapping make-stackage-lts + stackage-lts? + json->stackage-lts + (snapshot stackage-lts-snapshot "snapshot" json->snapshot) + (packages stackage-lts-packages "packages" + (lambda (vector) + (map json->stackage-package (vector->list vector))))) + +(define-json-mapping make-snapshot + stackage-snapshot? + json->snapshot + (name snapshot-name) + (ghc-version snapshot-ghc-version) + (compiler snapshot-compiler)) + +(define-json-mapping make-stackage-package + stackage-package? + json->stackage-package + (origin stackage-package-origin) + (name stackage-package-name) + (version stackage-package-version) + (synopsis stackage-package-synopsis)) (define (leave-with-message fmt . args) (raise (condition (&message (message (apply format #f fmt args)))))) @@ -65,21 +82,14 @@ (define stackage-lts-info-fetch "/lts-" (if (string-null? version) %default-lts-version version))) - (lts-info (json-fetch url))) - (if lts-info - (reverse lts-info) + (lts-info (and=> (json-fetch url) json->stackage-lts))) + (or lts-info (leave-with-message "LTS release version not found: ~a" version)))))) -(define (stackage-package-name pkg-info) - (assoc-ref pkg-info "name")) - -(define (stackage-package-version pkg-info) - (assoc-ref pkg-info "version")) - -(define (lts-package-version pkgs-info name) - "Return the version of the package with upstream NAME included in PKGS-INFO." +(define (lts-package-version packages name) + "Return the version of the package with upstream NAME included in PACKAGES." (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name)) - (vector->list pkgs-info)))) + packages))) (stackage-package-version pkg))) @@ -96,15 +106,15 @@ (define stackage->guix-package #:key (include-test-dependencies? #t) (lts-version %default-lts-version) - (packages-info - (lts-info-packages + (packages + (stackage-lts-packages (stackage-lts-info-fetch lts-version)))) "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org. The retrieved version corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION release at stackage.org. Return the `package' S-expression corresponding to that package, or #f on failure. PACKAGES-INFO is the alist with the packages included in the Stackage LTS release." - (let* ((version (lts-package-version packages-info package-name)) + (let* ((version (lts-package-version packages package-name)) (name-version (hackage-name-version package-name version))) (if name-version (hackage->guix-package name-version @@ -124,14 +134,15 @@ (define (stackage-recursive-import package-name . args) ;;; (define latest-lts-release - (let ((pkgs-info - (mlambda () (lts-info-packages - (stackage-lts-info-fetch %default-lts-version))))) + (let ((packages + (mlambda () + (stackage-lts-packages + (stackage-lts-info-fetch %default-lts-version))))) (lambda* (package) "Return an for the latest Stackage LTS release of PACKAGE or #f if the package is not included in the Stackage LTS release." (let* ((hackage-name (guix-package->hackage-name package)) - (version (lts-package-version (pkgs-info) hackage-name)) + (version (lts-package-version (packages) hackage-name)) (name-version (hackage-name-version hackage-name version))) (match (and=> name-version hackage-fetch) (#f (format (current-error-port) @@ -144,23 +155,21 @@ (define latest-lts-release (version version) (urls (list url)))))))))) -(define (stackage-package? package) - "Whether PACKAGE is available on the default Stackage LTS release." +(define (stackage-lts-package? package) + "Return whether PACKAGE is available on the default Stackage LTS release." (and (hackage-package? package) - (let ((packages (lts-info-packages + (let ((packages (stackage-lts-packages (stackage-lts-info-fetch %default-lts-version))) (hackage-name (guix-package->hackage-name package))) - (vector-any identity - (vector-map - (lambda (_ metadata) - (string=? (cdr (list-ref metadata 2)) hackage-name)) - packages))))) + (find (lambda (package) + (string=? (stackage-package-name package) hackage-name)) + packages)))) (define %stackage-updater (upstream-updater (name 'stackage) (description "Updater for Stackage LTS packages") - (pred stackage-package?) + (pred stackage-lts-package?) (latest latest-lts-release))) ;;; stackage.scm ends here diff --git a/tests/lint.scm b/tests/lint.scm index e96265a55a..699a750eb9 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -1319,7 +1319,11 @@ (define (package-with-phase-changes changes) (let* ((stackage (string-append "{ \"packages\": [{" " \"name\":\"pandoc\"," " \"synopsis\":\"synopsis\"," - " \"version\":\"1.0\" }]}")) + " \"version\":\"1.0\" }]," + " \"snapshot\": {" + " \"ghc\": \"8.6.5\"," + " \"name\": \"lts-14.27\"" + " }}")) (packages (map (lambda (version) (dummy-package "ghc-pandoc" -- cgit v1.2.3 From b7d8dc5841f9d71c6eac4c2c8faaf7f0b5e7748e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 30 Sep 2021 22:50:55 +0200 Subject: import: stackage: Use the standard diagnostic procedures. * guix/import/stackage.scm (leave-with-message): Remove. (stackage-lts-info-fetch): Use 'raise' and 'formatted-message'. (stackage->guix-package): Likewise. (latest-lts-release): Use 'warning' instead of 'format'. --- guix/import/stackage.scm | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) (limited to 'guix/import') diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 4eff09ad01..b4b20ebcf0 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -32,6 +32,8 @@ (define-module (guix import stackage) #:use-module (guix memoization) #:use-module (guix packages) #:use-module (guix upstream) + #:use-module (guix diagnostics) + #:use-module (guix i18n) #:export (%stackage-url stackage->guix-package stackage-recursive-import @@ -71,9 +73,6 @@ (define-json-mapping make-stackage-package (version stackage-package-version) (synopsis stackage-package-synopsis)) -(define (leave-with-message fmt . args) - (raise (condition (&message (message (apply format #f fmt args)))))) - (define stackage-lts-info-fetch ;; "Retrieve the information about the LTS Stackage release VERSION." (memoize @@ -84,7 +83,8 @@ (define stackage-lts-info-fetch version))) (lts-info (and=> (json-fetch url) json->stackage-lts))) (or lts-info - (leave-with-message "LTS release version not found: ~a" version)))))) + (raise (formatted-message (G_ "LTS release version not found: ~a") + version))))))) (define (lts-package-version packages name) "Return the version of the package with upstream NAME included in PACKAGES." @@ -120,7 +120,8 @@ (define stackage->guix-package (hackage->guix-package name-version #:include-test-dependencies? include-test-dependencies?) - (leave-with-message "~a: Stackage package not found" package-name)))))) + (raise (formatted-message (G_ "~a: Stackage package not found") + package-name))))))) (define (stackage-recursive-import package-name . args) (recursive-import package-name @@ -145,10 +146,10 @@ (define latest-lts-release (version (lts-package-version (packages) hackage-name)) (name-version (hackage-name-version hackage-name version))) (match (and=> name-version hackage-fetch) - (#f (format (current-error-port) - "warning: failed to parse ~a~%" - (hackage-cabal-url hackage-name)) - #f) + (#f + (warning (G_ "failed to parse ~a~%") + (hackage-cabal-url hackage-name)) + #f) (_ (let ((url (hackage-source-url hackage-name version))) (upstream-source (package (package-name package)) -- cgit v1.2.3 From 085a8a0cdfef7c414c92dcf2b0ea9aa970888a62 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Mon, 20 Sep 2021 15:27:08 +0200 Subject: import/minetest: Define an updater for mods on ContentDB. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Only detecting updates is currently supported. To actually perform the uppdates, a patch like is required. * guix/import/minetest.scm (version-style,minetest-package?,latest-minetest-release): New procedures. (%minetest-updater): New updater. * tests/minetest.scm (upstream-source->sexp,expected-sexp,example-package): New procedure. (test-release,test-no-release): New macro's. ("same version","new version (dotted)","new version (date)") ("new version (git -> dotted)","dotted->date","date->dotted") ("no commit informaton, no new release") ("minetest is not a minetest mod") ("technic is a minetest mod") ("upstream-name is required"): New tests. Signed-off-by: Ludovic Courtès --- guix/import/minetest.scm | 53 ++++++++++++++++++++- tests/minetest.scm | 120 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 172 insertions(+), 1 deletion(-) (limited to 'guix/import') diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm index ba86c60bfd..0f3ab473ca 100644 --- a/guix/import/minetest.scm +++ b/guix/import/minetest.scm @@ -25,6 +25,8 @@ (define-module (guix import minetest) #:use-module (srfi srfi-2) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module ((guix packages) #:prefix package:) + #:use-module (guix upstream) #:use-module (guix utils) #:use-module (guix ui) #:use-module (guix i18n) @@ -36,15 +38,19 @@ (define-module (guix import minetest) #:use-module (json) #:use-module (guix base32) #:use-module (guix git) + #:use-module ((guix git-download) #:prefix download:) #:use-module (guix store) #:export (%default-sort-key %contentdb-api json->package contentdb-fetch elaborate-contentdb-name + minetest-package? + latest-minetest-release minetest->guix-package minetest-recursive-import - sort-packages)) + sort-packages + %minetest-updater)) ;; The ContentDB API is documented at ;; . @@ -345,6 +351,17 @@ (define title (release-title release)) (substring title 1) title)) +(define (version-style version) + "Determine the kind of version number VERSION is -- a date, or a conventional +conventional version number." + (define dots? (->bool (string-index version #\.))) + (define hyphens? (->bool (string-index version #\-))) + (match (cons dots? hyphens?) + ((#true . #false) 'regular) ; something like "0.1" + ((#false . #false) 'regular) ; single component version number + ((#true . #true) 'regular) ; result of 'git-version' + ((#false . #true) 'date))) ; something like "2021-01-25" + ;; If the default sort key is changed, make sure to modify 'show-help' ;; in (guix scripts import minetest) appropriately as well. (define %default-sort-key "score") @@ -466,3 +483,37 @@ (define* (minetest->guix-package* author/name #:key repo version) (recursive-import author/name #:repo->guix-package minetest->guix-package* #:guix-name contentdb->package-name)) + +(define (minetest-package? pkg) + "Is PKG a Minetest mod on ContentDB?" + (and (string-prefix? "minetest-" (package:package-name pkg)) + (assq-ref (package:package-properties pkg) 'upstream-name))) + +(define (latest-minetest-release pkg) + "Return an for the latest release of the package PKG, +or #false if the latest release couldn't be determined." + (define author/name + (assq-ref (package:package-properties pkg) 'upstream-name)) + (define contentdb-package (contentdb-fetch author/name)) ; TODO warn if #f? + (define release (latest-release author/name)) + (define source (package:package-source pkg)) + (and contentdb-package release + (release-commit release) ; not always set + ;; Only continue if both the old and new version number are both + ;; dates or regular version numbers, as two different styles confuses + ;; the logic for determining which version is newer. + (eq? (version-style (release-version release)) + (version-style (package:package-version pkg))) + (upstream-source + (package (package:package-name pkg)) + (version (release-version release)) + (urls (list (download:git-reference + (url (package-repository contentdb-package)) + (commit (release-commit release)))))))) + +(define %minetest-updater + (upstream-updater + (name 'minetest) + (description "Updater for Minetest packages on ContentDB") + (pred minetest-package?) + (latest latest-minetest-release))) diff --git a/tests/minetest.scm b/tests/minetest.scm index abb26d0a03..77b9aa928f 100644 --- a/tests/minetest.scm +++ b/tests/minetest.scm @@ -17,10 +17,18 @@ ;;; along with GNU Guix. If not, see . (define-module (test-minetest) + #:use-module (guix build-system minetest) + #:use-module (guix upstream) #:use-module (guix memoization) #:use-module (guix import minetest) #:use-module (guix import utils) #:use-module (guix tests) + #:use-module (guix packages) + #:use-module (guix git-download) + #:use-module ((gnu packages minetest) + #:select (minetest minetest-technic)) + #:use-module ((gnu packages base) + #:select (hello)) #:use-module (json) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -375,8 +383,120 @@ (define-syntax-rule (test-package* test-case primary-arguments extra-arguments (list z y x) (sort-packages (list x y z)))) + + +;; Update detection +(define (upstream-source->sexp upstream-source) + (define urls (upstream-source-urls upstream-source)) + (unless (= 1 (length urls)) + (error "only a single URL is expected")) + (define url (first urls)) + `(,(upstream-source-package upstream-source) + ,(upstream-source-version upstream-source) + ,(git-reference-url url) + ,(git-reference-commit url))) + +(define* (expected-sexp #:key + (repo "https://example.org/foo.git") + (guix-name "minetest-foo") + (new-version "0.8") + (commit "44941798d222901b8f381b3210957d880b90a2fc") + #:allow-other-keys) + `(,guix-name ,new-version ,repo ,commit)) + +(define* (example-package #:key + (source 'auto) + (repo "https://example.org/foo.git") + (old-version "0.8") + (commit "44941798d222901b8f381b3210957d880b90a2fc") + #:allow-other-keys) + (package + (name "minetest-foo") + (version old-version) + (source + (if (eq? source 'auto) + (origin + (method git-fetch) + (uri (git-reference + (url repo) + (commit commit #;"808f9ffbd3106da4c92d2367b118b98196c9e81e"))) + (sha256 #f) ; not important for the following tests + (file-name (git-file-name name version))) + source)) + (build-system minetest-mod-build-system) + (license #f) + (synopsis #f) + (description #f) + (home-page #f) + (properties '((upstream-name . "Author/foo"))))) + +(define-syntax-rule (test-release test-case . arguments) + (test-equal test-case + (expected-sexp . arguments) + (and=> + (call-with-packages + (cut latest-minetest-release (example-package . arguments)) + (list . arguments)) + upstream-source->sexp))) + +(define-syntax-rule (test-no-release test-case . arguments) + (test-equal test-case + #f + (call-with-packages + (cut latest-minetest-release (example-package . arguments)) + (list . arguments)))) + +(test-release "same version" + #:old-version "0.8" #:title "0.8" #:new-version "0.8" + #:commit "44941798d222901b8f381b3210957d880b90a2fc") + +(test-release "new version (dotted)" + #:old-version "0.8" #:title "0.9.0" #:new-version "0.9.0" + #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a") + +(test-release "new version (date)" + #:old-version "2014-11-17" #:title "2015-11-04" + #:new-version "2015-11-04" + #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a") + +(test-release "new version (git -> dotted)" + #:old-version + (git-version "0.8" "1" "90422555f114d3af35e7cc4b5b6d59a5c226adc4") + #:title "0.9.0" #:new-version "0.9.0" + #:commit "90422555f114d3af35e7cc4b5b6d59a5c226adc4") + +;; There might actually be a new release, but guix cannot compare dates +;; with regular version numbers. +(test-no-release "dotted -> date" + #:old-version "0.8" #:title "2015-11-04" + #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a") + +(test-no-release "date -> dotted" + #:old-version "2014-11-07" #:title "0.8" + #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a") + +;; Don't let "guix refresh -t minetest" tell there are new versions +;; if Guix has insufficient information to actually perform the update, +;; when using --with-latest or "guix refresh -u". +(test-no-release "no commit information, no new release" + #:old-version "0.8" #:title "0.9.0" #:new-version "0.9.0" + #:commit #false) + +(test-assert "minetest is not a minetest mod" + (not (minetest-package? minetest))) +(test-assert "GNU hello is not a minetest mod" + (not (minetest-package? hello))) +(test-assert "technic is a minetest mod" + (minetest-package? minetest-technic)) +(test-assert "upstream-name is required" + (not (minetest-package? + (package (inherit minetest-technic) + (properties '()))))) + (test-end "minetest") ;;; Local Variables: ;;; eval: (put 'test-package* 'scheme-indent-function 1) +;;; eval: (put 'test-release 'scheme-indent-function 1) +;;; eval: (put 'test-no-release 'scheme-indent-function 1) ;;; End: -- cgit v1.2.3 From ac43ead7741357cb620d6a0eb80ae754851b8fa1 Mon Sep 17 00:00:00 2001 From: Sarah Morgensen Date: Tue, 28 Sep 2021 19:49:58 -0700 Subject: import: go: Handle extra whitespace in "go-import" meta tags. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Some packages sites use extra whitespace in the content portion of tags, so handle that. Example: * guix/import/go.scm (fetch-module-meta-data)[go-import->module-meta]: Use 'string-tokenize' instead of 'string-split'. Signed-off-by: Ludovic Courtès --- guix/import/go.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/import') diff --git a/guix/import/go.scm b/guix/import/go.scm index 9769b557ae..ca909ab35a 100644 --- a/guix/import/go.scm +++ b/guix/import/go.scm @@ -474,7 +474,7 @@ (define (fetch-module-meta-data module-path) because goproxy servers don't currently provide all the information needed to build a package." (define (go-import->module-meta content-text) - (match (string-split content-text #\space) + (match (string-tokenize content-text char-set:graphic) ((root-path vcs repo-url) (make-module-meta root-path (string->symbol vcs) (strip-.git-suffix/maybe repo-url))))) -- cgit v1.2.3 From 834ff65e8525a9a90545b34504a9098142e3163b Mon Sep 17 00:00:00 2001 From: Sarah Morgensen Date: Tue, 28 Sep 2021 19:59:32 -0700 Subject: import: go: Recognize major version suffixes. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Do not treat major version suffixes (such as "/v3") as repository subdirectories. See . * guix/import/go.scm (go-module->guix-package): When determining the unpack path, compare 'root-module-path' to 'module-path-sans-suffix' instead of 'module-path'. Signed-off-by: Ludovic Courtès --- guix/import/go.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix/import') diff --git a/guix/import/go.scm b/guix/import/go.scm index ca909ab35a..26dbc34b63 100644 --- a/guix/import/go.scm +++ b/guix/import/go.scm @@ -612,6 +612,8 @@ (define* (go-module->guix-package module-path #:key (dependencies (if pin-versions? dependencies+versions (map car dependencies+versions))) + (module-path-sans-suffix + (match:prefix (string-match "([\\./]v[0-9]+)?$" module-path))) (guix-name (go-module->guix-package-name module-path)) (root-module-path (module-path->repository-root module-path)) ;; The VCS type and URL are not included in goproxy information. For @@ -631,7 +633,7 @@ (define* (go-module->guix-package module-path #:key (build-system go-build-system) (arguments '(#:import-path ,module-path - ,@(if (string=? module-path root-module-path) + ,@(if (string=? module-path-sans-suffix root-module-path) '() `(#:unpack-path ,root-module-path)))) ,@(maybe-propagated-inputs -- cgit v1.2.3 From 1327ec822fa6dd396e979efd8d4e1f7479f1d5b3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 7 Oct 2021 09:50:26 +0200 Subject: import: crate: Gracefully handle missing license info. Fixes . Reported by Michael Zappa . * guix/import/crate.scm ()[license]: Translate 'null to #f. (make-crate-sexp): Handle LICENSE = #f. --- guix/import/crate.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'guix/import') diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 287ffd2536..c76d7e9c1a 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 David Craven -;;; Copyright © 2019, 2020 Ludovic Courtès +;;; Copyright © 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2019, 2020 Martin Becze ;;; Copyright © 2021 Nicolas Goaziou ;;; @@ -79,7 +79,10 @@ (define-json-mapping make-crate-version crate-version? (number crate-version-number "num") ;string (download-path crate-version-download-path "dl_path") ;string (readme-path crate-version-readme-path "readme_path") ;string - (license crate-version-license "license") ;string + (license crate-version-license "license" ;string | #f + (match-lambda + ('null #f) + ((? string? str) str))) (links crate-version-links)) ;alist ;; Crate dependency. Each dependency (each edge in the graph) is annotated as @@ -198,6 +201,7 @@ (define (format-inputs inputs) (description ,(beautify-description description)) (license ,(match license (() #f) + (#f #f) ((license) license) (_ `(list ,@license))))))) (close-port port) -- cgit v1.2.3 From d780d0a2bbd1cdb7b688b3933ec6d6a1eb27e150 Mon Sep 17 00:00:00 2001 From: Hartmut Goebel Date: Sun, 24 May 2020 22:17:30 +0200 Subject: import: Add hex.pm importer. hex.pm is a package repository for Erlang and Elixir. * guix/scripts/import.scm (importers): Add "hexpm". * guix/scripts/import/hexpm.scm, guix/import/hexpm.scm, guix/hexpm-download.scm: New files. * guix/import/utils.scm (source-spec->object): Add "hexpm-fetch" to list of fetch methods. * guix/upstream.scm (package-update/hexpm-fetch): New function. (%method-updates) Add it. * Makefile.am: Add them. --- Makefile.am | 3 + 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 ++- 7 files changed, 504 insertions(+), 2 deletions(-) create mode 100644 guix/hexpm-download.scm create mode 100644 guix/import/hexpm.scm create mode 100644 guix/scripts/import/hexpm.scm (limited to 'guix/import') diff --git a/Makefile.am b/Makefile.am index f2b6c8e8da..ce79d4bc04 100644 --- a/Makefile.am +++ b/Makefile.am @@ -99,6 +99,7 @@ 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 \ @@ -262,6 +263,7 @@ 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 \ @@ -309,6 +311,7 @@ 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/guix/hexpm-download.scm b/guix/hexpm-download.scm new file mode 100644 index 0000000000..25247cb79b --- /dev/null +++ b/guix/hexpm-download.scm @@ -0,0 +1,76 @@ +;;; 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 new file mode 100644 index 0000000000..018732d8c1 --- /dev/null +++ b/guix/import/hexpm.scm @@ -0,0 +1,290 @@ +;;; 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 a180742ca3..aaad247c63 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -359,6 +359,7 @@ (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 40fa6759ae..aaadad4adf 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" + "gem" "go" "cran" "crate" "texlive" "json" "opam" "hexpm" "minetest")) (define (resolve-importer name) diff --git a/guix/scripts/import/hexpm.scm b/guix/scripts/import/hexpm.scm new file mode 100644 index 0000000000..95a291f1a8 --- /dev/null +++ b/guix/scripts/import/hexpm.scm @@ -0,0 +1,114 @@ +;;; 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 632e9ebc4f..f1fb84eb45 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -24,6 +24,10 @@ (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) @@ -430,9 +434,23 @@ (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))) + `((,url-fetch . ,package-update/url-fetch) + (,hexpm-fetch . ,package-update/hexpm-fetch))) (define* (package-update store package #:optional (updaters (force %updaters)) -- cgit v1.2.3 From 75c91e6b43ea6a6e7d4b877abdf8f675aa498763 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Tue, 14 Sep 2021 11:43:37 +0200 Subject: import: stackage: Update %default-lts-version to 18.10. * guix/import/stackage.scm (%default-lts-version): Update to 18.10. --- guix/import/stackage.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix/import') diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index b4b20ebcf0..c7247f5ff8 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -47,8 +47,8 @@ (define-module (guix import stackage) (define %stackage-url (make-parameter "https://www.stackage.org")) -;; Latest LTS version compatible with GHC 8.6.5. -(define %default-lts-version "14.27") +;; Latest LTS version compatible with current GHC. +(define %default-lts-version "18.10") (define-json-mapping make-stackage-lts stackage-lts? -- cgit v1.2.3 From 8b4d3a523fc20ba7c3c65e6a60d6dd11e789831f Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Tue, 14 Sep 2021 13:15:07 +0200 Subject: import: hackage: Update GHC’s standard libraries. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/import/hackage.scm (ghc-standard-libraries): Add exceptions library. --- guix/import/hackage.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix/import') diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index f94a1e7087..0a10c421bb 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -54,8 +54,8 @@ (define-module (guix import hackage) hackage-package?)) (define ghc-standard-libraries - ;; List of libraries distributed with ghc (8.6.5). - ;; Contents of ...-ghc-8.6.5/lib/ghc-8.6.5. + ;; List of libraries distributed with ghc (as of 8.10.7). + ;; Contents of …-ghc-8.10.7/lib/ghc-8.10.7 '("ghc" "cabal" ;; in the output of `ghc-pkg list` Cabal is uppercased, but ;; hackage-name->package-name takes this into account. @@ -67,6 +67,7 @@ (define ghc-standard-libraries "containers" "deepseq" "directory" + "exceptions" "filepath" "ghc" "ghc-boot" -- cgit v1.2.3 From 127828ddd74fc950c0403ca58a6f650355e3d67d Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Thu, 16 Sep 2021 08:12:17 +0200 Subject: import: stackage: Support input changes. * guix/import/stackage.scm (latest-lts-release): Rename package to pkg to avoid name conflict and add input-changes. --- guix/import/stackage.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'guix/import') diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index c7247f5ff8..f58c6b163d 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -139,10 +139,10 @@ (define latest-lts-release (mlambda () (stackage-lts-packages (stackage-lts-info-fetch %default-lts-version))))) - (lambda* (package) + (lambda* (pkg) "Return an for the latest Stackage LTS release of PACKAGE or #f if the package is not included in the Stackage LTS release." - (let* ((hackage-name (guix-package->hackage-name package)) + (let* ((hackage-name (guix-package->hackage-name pkg)) (version (lts-package-version (packages) hackage-name)) (name-version (hackage-name-version hackage-name version))) (match (and=> name-version hackage-fetch) @@ -152,9 +152,13 @@ (define latest-lts-release #f) (_ (let ((url (hackage-source-url hackage-name version))) (upstream-source - (package (package-name package)) + (package (package-name pkg)) (version version) - (urls (list url)))))))))) + (urls (list url)) + (input-changes + (changed-inputs + pkg + (stackage->guix-package hackage-name #:packages (packages)))))))))))) (define (stackage-lts-package? package) "Return whether PACKAGE is available on the default Stackage LTS release." -- cgit v1.2.3 From edd912a128cf467050c1a76a021d91ea8b90e759 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Fri, 17 Sep 2021 11:09:04 +0200 Subject: import: hackage: Support mirror:// URLs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/import/hackage.scm (guix-package->hackage-name): Support mirror://-style URI’s. (hackage-package?): Ditto. --- guix/import/hackage.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'guix/import') diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 0a10c421bb..03881f1a3d 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -121,12 +121,12 @@ (define (hackage-name->package-name name) (string-append package-name-prefix (string-downcase name)))) (define guix-package->hackage-name - (let ((uri-rx (make-regexp "https?://hackage.haskell.org/package/([^/]+)/.*")) + (let ((uri-rx (make-regexp "(https?://hackage.haskell.org|mirror://hackage)/package/([^/]+)/.*")) (name-rx (make-regexp "(.*)-[0-9\\.]+"))) (lambda (package) "Given a Guix package name, return the corresponding Hackage name." (let* ((source-url (and=> (package-source package) origin-uri)) - (name (match:substring (regexp-exec uri-rx source-url) 1))) + (name (match:substring (regexp-exec uri-rx source-url) 2))) (match (regexp-exec name-rx name) (#f name) (m (match:substring m 1))))))) @@ -353,7 +353,7 @@ (define* (hackage-recursive-import package-name . args) #:guix-name hackage-name->package-name)) (define hackage-package? - (let ((hackage-rx (make-regexp "https?://hackage.haskell.org"))) + (let ((hackage-rx (make-regexp "(https?://hackage.haskell.org|mirror://hackage/)"))) (url-predicate (cut regexp-exec hackage-rx <>)))) (define (latest-release package) -- 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/import') 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