81c3dc3224
Guile-JSON 3.x is incompatible with Guile-JSON 1.x, which we relied on
until now: it maps JSON dictionaries to alists (instead of hash tables),
and JSON arrays to vectors (instead of lists). This commit is about
adjusting all the existing code to this new mapping.
* m4/guix.m4 (GUIX_CHECK_GUILE_JSON): New macro.
* configure.ac: Use it.
* doc/guix.texi (Requirements): Mention the Guile-JSON version.
* guix/git-download.scm (git-fetch)[guile-json]: Use GUILE-JSON-3.
* guix/import/cpan.scm (string->license): Expect vectors instead of
lists.
(module->dist-name): Use 'json-fetch' instead of 'json-fetch-alist'.
(cpan-fetch): Likewise.
* guix/import/crate.scm (crate-fetch): Likewise, and call 'vector->list'
for DEPS.
* guix/import/gem.scm (rubygems-fetch): Likewise.
* guix/import/json.scm (json-fetch-alist): Remove.
* guix/import/pypi.scm (pypi-fetch): Use 'json-fetch' instead of
'json-fetch-alist'.
(latest-source-release, latest-wheel-release): Call 'vector->list' on
RELEASES.
* guix/import/stackage.scm (stackage-lts-info-fetch): Use 'json-fetch'
instead of 'json-fetch-alist'.
(lts-package-version): Use 'vector->list'.
* guix/import/utils.scm (hash-table->alist): Remove.
(alist->package): Pass 'vector->list' on the inputs fields, and default
to the empty vector.
* guix/scripts/import/json.scm (guix-import-json): Remove call to
'hash-table->alist'.
* guix/swh.scm (define-json-reader): Expect pair? or null? instead of
hash-table?.
[extract-field]: Use 'assoc-ref' instead of 'hash-ref'.
(json->branches): Use 'map' instead of 'hash-map->list'.
(json->checksums): Likewise.
(json->directory-entries, origin-visits): Call 'vector->list' on the
result of 'json->scm'.
* tests/import-utils.scm ("alist->package with dependencies"): New test.
* gnu/installer.scm (build-compiled-file)[builder]: Use GUILE-JSON-3.
* gnu/installer.scm (installer-program)[installer-builder]: Likewise.
* gnu/installer/locale.scm (iso639->iso639-languages): Use 'assoc-ref'
instead of 'hash-ref', and pass vectors through 'vector->list'.
(iso3166->iso3166-territories): Likewise.
* gnu/system/vm.scm (system-docker-image)[build]: Use GUILE-JSON-3.
* guix/docker.scm (manifest, config): Adjust for Guile-JSON 3.
* guix/scripts/pack.scm (docker-image)[build]: Use GUILE-JSON-3.
* guix/import/github.scm (fetch-releases-or-tags): Update docstring.
(latest-released-version): Use 'assoc-ref' instead of 'hash-ref'. Pass
the result of 'fetch-releases-or-tags' to 'vector->list'.
* guix/import/launchpad.scm (latest-released-version): Likewise.
148 lines
5.4 KiB
Scheme
148 lines
5.4 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
||
;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
|
||
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
|
||
;;;
|
||
;;; 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 (ice-9 regex)
|
||
#:use-module (srfi srfi-1)
|
||
#:use-module (srfi srfi-26)
|
||
#:use-module (srfi srfi-34)
|
||
#:use-module (srfi srfi-35)
|
||
#:use-module (guix import json)
|
||
#:use-module (guix import hackage)
|
||
#:use-module (guix import utils)
|
||
#:use-module (guix memoization)
|
||
#:use-module (guix packages)
|
||
#:use-module (guix upstream)
|
||
#:export (stackage->guix-package
|
||
stackage-recursive-import
|
||
%stackage-updater))
|
||
|
||
|
||
;;;
|
||
;;; Stackage info fetcher and access functions
|
||
;;;
|
||
|
||
(define %stackage-url "http://www.stackage.org")
|
||
|
||
(define (lts-info-ghc-version lts-info)
|
||
"Retruns the version of the GHC compiler contained in LTS-INFO."
|
||
(and=> (assoc-ref lts-info "snapshot")
|
||
(cut assoc-ref <> "ghc")))
|
||
|
||
(define (lts-info-packages lts-info)
|
||
"Retruns the alist of packages contained in LTS-INFO."
|
||
(or (assoc-ref lts-info "packages") '()))
|
||
|
||
(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
|
||
(lambda* (#:optional (version ""))
|
||
(let* ((url (if (string=? "" version)
|
||
(string-append %stackage-url "/lts")
|
||
(string-append %stackage-url "/lts-" version)))
|
||
(lts-info (json-fetch url)))
|
||
(if lts-info
|
||
(reverse 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."
|
||
(let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name))
|
||
(vector->list pkgs-info))))
|
||
(stackage-package-version pkg)))
|
||
|
||
|
||
;;;
|
||
;;; 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 "")
|
||
(packages-info
|
||
(lts-info-packages
|
||
(stackage-lts-info-fetch lts-version))))
|
||
"Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org. The retrieved
|
||
vesion 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))
|
||
(name-version (hackage-name-version package-name version)))
|
||
(if name-version
|
||
(hackage->guix-package name-version
|
||
#:include-test-dependencies?
|
||
include-test-dependencies?)
|
||
(leave-with-message "~a: Stackage package not found" package-name))))))
|
||
|
||
(define (stackage-recursive-import package-name . args)
|
||
(recursive-import package-name #f
|
||
#:repo->guix-package (lambda (name repo)
|
||
(apply stackage->guix-package (cons name args)))
|
||
#:guix-name hackage-name->package-name))
|
||
|
||
|
||
;;;
|
||
;;; Updater
|
||
;;;
|
||
|
||
(define latest-lts-release
|
||
(let ((pkgs-info (mlambda () (lts-info-packages (stackage-lts-info-fetch)))))
|
||
(lambda* (package)
|
||
"Return an <upstream-source> for the latest Stackage LTS release of
|
||
PACKAGE or #f it the package is not inlucded in the Stackage LTS release."
|
||
(let* ((hackage-name (guix-package->hackage-name package))
|
||
(version (lts-package-version (pkgs-info) 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)
|
||
(_ (let ((url (hackage-source-url hackage-name version)))
|
||
(upstream-source
|
||
(package (package-name package))
|
||
(version version)
|
||
(urls (list url))))))))))
|
||
|
||
(define %stackage-updater
|
||
(upstream-updater
|
||
(name 'stackage)
|
||
(description "Updater for Stackage LTS packages")
|
||
(pred hackage-package?)
|
||
(latest latest-lts-release)))
|
||
|
||
;;; stackage.scm ends here
|