mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
* guix/import/utils.scm (find-version): New procedure. * guix/scripts/refresh.scm (<update-spec>) [partial?]: New field. (update-spec-partial?): New accessor. (update-spec): Add a PARTIAL? optional argument. (update-specification->update-spec) <update-spec>: Call with its new PARTIAL? optional argument when FALLBACK-VERSION is provided, i.e. when '--target-version' was used. (update-package): Remove the PACKAGE and VERSION positional arguments, and replace them with UPDATE-SPEC. Update doc. Call `package-update' with its new #:partial-version? argument. (check-for-package-update) <package-latest-release>: Pass the new #:partial-version? argument to it. (guix-refresh) <update-package>: Adjust call accordingly. (show-help): Udate doc. * guix/upstream.scm (package-latest-release): Add #:partial-version? argument, and apply it to the importer call. (package-update): Add #:partial-version?> argument. Update doc. Pass it to the `package-latest-release' call. * guix/gnu-maintenance.scm (rewrite-url): Add #:partial-version? argument. Update doc. Crawl URL for newer compatible versions when provided. (import-html-release): Add #:partial-version? argument, and pass it to the `rewrite-url' call. Use `find-version' to find the best version. (import-release, import-ftp-release, import-gnu-release) (import-release*): Add #:partial-version? argument and honor it. (import-html-updatable-release): Add #:partial-version? argument, and pass it to the `import-html-release' call. * guix/import/gnome.scm (import-gnome-release) <#:partial-version?>: Add new argument and honor it. * guix/import/texlive.scm (latest-texlive-tag): Rename to... (texlive-tags): ... this, and have it return all tags. (texlive->guix-package): Adjust accordingly. (latest-release): Add a #:partial-version? argument. Update doc. * guix/import/stackage.scm (latest-lts-release): New #:partial-version? argument. * guix/import/pypi.scm (import-release): New #:partial-version? argument; pass it to `pypi-package->upstream-source'. * guix/import/opam.scm (latest-release): New #:partial-version? argument. * guix/import/minetest.scm (latest-minetest-release): New #:partial-version? argument. (pypi-package->upstream-source): New #:partial-version? argument. Update doc. * guix/import/launchpad.scm (latest-released-version): Rename to... (release-versions): ... this, making it return all versions. (import-release) <#:partial-version?>: New argument. * guix/import/kde.scm (import-kde-release) <#:partial-version?>: New argument. Update doc. Refactor to honor argument. * guix/import/hexpm.scm (lookup-hexpm): Update doc. (hexpm-latest-release): Rename to... (hexpm-releases): ... this; return all release strings. (hexpm->guix-package): Adjust accordingly. (import-release): Add and honor a #:partial-version? argument. Update doc. * guix/import/hackage.scm (import-release): New #:partial-version? argument. * guix/import/cpan.scm (latest-release): New #:partial-version? argument. * guix/import/crate.scm (max-crate-version-of-semver): Improve doc. (import-release): Add a #:partial-version? argument and honor it. * guix/import/egg.scm (find-latest-version): Rename to... (get-versions): ... this, returning all versions. (egg-metadata): Adjust accordingly. (egg->guix-package): Likewise. (import-release): Add a new #:partial-version? argument and honor it. * guix/import/elpa.scm (latest-release): New #:partial-version? argument. * guix/import/gem.scm (get-versions): New procedure. (import-release): Add a new #:partial-version? argument and honor it. * guix/import/git.scm (version-mapping): Update doc; streamline a bit. (latest-tag): Rename to... (get-tags): ... this, dropping the #:version keyword and returning the complete tags alist. Update doc. (latest-git-tag-version): Rename to... (get-package-tags): ... this, returning the complete tags alist of the package. Update doc. (import-git-release): Add a new #:partial-version? argument and honor it. Update doc. * guix/import/github.scm (latest-released-version): Rename to... (get-package-tags): ... this, returning all tags. Update doc. (import-release): Add a new #:partial-version? argument and honor it. * guix/import/cran.scm (latest-cran-release) (latest-bioconductor-release): Add #:partial-version? argument. * guix/import/composer.scm (latest-version): Delete procedure. (composer-fetch): Add #:partial-version? keyword and honor it. Update doc. (import-release): Likewise. * guix/import/test.scm (import-release): Add #:partial-version? argument. * tests/guix-refresh.sh: Add test. * tests/gem.scm (test-foo-versions-json): New variable. (package-latest-release): Mock new URL. * tests/import-git.scm (latest-git-tag-version): New procedure. * tests/gnu-maintenance.scm (libuv-dist-html) (libuv-dist-1.46.0-html, libuv-dist-1.44.2-html) (libuv-html-data): New variables. (mock-http-fetch/cached): New procedure. ("rewrite-url, without to-version"): Rewrite using the above. ("rewrite-url, partial to-version"): New test. * doc/guix.texi <"Invoking guix refresh">: Update doc. Series-to: 75871@debbugs.gnu.org Change-Id: I092a58b57ac42e54a2fa55e7761e8c6993af8ad4
189 lines
7.1 KiB
Scheme
189 lines
7.1 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
||
;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
|
||
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
|
||
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
|
||
;;; Copyright © 2021 Xinglu Chem <public@yoctocell.xyz>
|
||
;;; Copyright © 2021, 2023, 2023 Ludovic Courtès <ludo@gnu.org>
|
||
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
|
||
;;;
|
||
;;; 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 <http://www.gnu.org/licenses/>.
|
||
|
||
(define-module (guix import stackage)
|
||
#:use-module (ice-9 match)
|
||
#:use-module (json)
|
||
#:use-module (srfi srfi-1)
|
||
#:use-module (srfi srfi-34)
|
||
#:use-module (srfi srfi-35)
|
||
#:use-module (guix import json)
|
||
#:use-module (guix import hackage)
|
||
#:autoload (guix import cabal) (eval-cabal)
|
||
#:use-module (guix import utils)
|
||
#: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
|
||
%stackage-updater))
|
||
|
||
|
||
;;;
|
||
;;; Stackage info fetcher and access functions
|
||
;;;
|
||
|
||
(define %stackage-url
|
||
(make-parameter "https://www.stackage.org"))
|
||
|
||
;; Latest LTS version compatible with current GHC.
|
||
(define %default-lts-version "20.26")
|
||
|
||
(define-json-mapping <stackage-lts> 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 <snapshot> make-snapshot
|
||
stackage-snapshot?
|
||
json->snapshot
|
||
(name snapshot-name)
|
||
(ghc-version snapshot-ghc-version)
|
||
(compiler snapshot-compiler))
|
||
|
||
(define-json-mapping <stackage-package> 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 stackage-lts-info-fetch
|
||
;; "Retrieve the information about the LTS Stackage release VERSION."
|
||
(memoize
|
||
(lambda* (#:optional (version ""))
|
||
(let* ((url (string-append (%stackage-url)
|
||
"/lts-" (if (string-null? version)
|
||
%default-lts-version
|
||
version)))
|
||
(lts-info (and=> (json-fetch url) json->stackage-lts)))
|
||
(or lts-info
|
||
(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."
|
||
(let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name))
|
||
packages)))
|
||
(and=> pkg stackage-package-version)))
|
||
|
||
|
||
;;;
|
||
;;; Importer entry point
|
||
;;;
|
||
|
||
(define (hackage-name-version name version)
|
||
(and version (string-append name "@" version)))
|
||
|
||
(define stackage->guix-package
|
||
(memoize
|
||
(lambda* (package-name ; upstream name
|
||
#:key
|
||
(include-test-dependencies? #t)
|
||
(lts-version %default-lts-version)
|
||
(packages
|
||
(stackage-lts-packages
|
||
(stackage-lts-info-fetch lts-version)))
|
||
#:allow-other-keys)
|
||
"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 package-name))
|
||
(name-version (hackage-name-version package-name version)))
|
||
(if name-version
|
||
(hackage->guix-package name-version
|
||
#:include-test-dependencies?
|
||
include-test-dependencies?)
|
||
(raise (formatted-message (G_ "~a: Stackage package not found")
|
||
package-name)))))))
|
||
|
||
(define (stackage-recursive-import package-name . args)
|
||
(recursive-import package-name
|
||
#:repo->guix-package (lambda* (name #:key version #:allow-other-keys)
|
||
(apply stackage->guix-package (cons name args)))
|
||
#:guix-name hackage-name->package-name))
|
||
|
||
|
||
;;;
|
||
;;; Updater
|
||
;;;
|
||
|
||
(define latest-lts-release
|
||
(let ((packages
|
||
(mlambda ()
|
||
(stackage-lts-packages
|
||
(stackage-lts-info-fetch %default-lts-version)))))
|
||
(lambda* (pkg #:key version partial-version?)
|
||
"Return an <upstream-source> for the latest Stackage LTS release of
|
||
PACKAGE or #f if the package is not included in the Stackage LTS release."
|
||
(when version
|
||
(raise
|
||
(formatted-message
|
||
(G_ "~a updater doesn't support updating to a specific version, sorry.")
|
||
"stackage")))
|
||
(let* ((hackage-name (package-upstream-name* pkg))
|
||
(version (lts-package-version (packages) hackage-name)))
|
||
(match (and hackage-name version
|
||
(hackage-fetch hackage-name version))
|
||
(#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 pkg))
|
||
(version version)
|
||
(urls (list url))
|
||
(inputs
|
||
(let ((cabal (eval-cabal (hackage-fetch hackage-name version)
|
||
'())))
|
||
(cabal-package-inputs cabal)))))))))))
|
||
|
||
(define (stackage-lts-package? package)
|
||
"Return whether PACKAGE is available on the default Stackage LTS release."
|
||
(and (hackage-package? package)
|
||
(false-if-networking-error
|
||
(let ((packages (stackage-lts-packages
|
||
(stackage-lts-info-fetch %default-lts-version)))
|
||
(hackage-name (package-upstream-name* package)))
|
||
(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-lts-package?)
|
||
(import latest-lts-release)))
|
||
|
||
;;; stackage.scm ends here
|