ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: stackage: Use the standard diagnostic procedures.

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2021-09-30 22:50:55 +02:00
parent 46d15af4cb
commit b7d8dc5841
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 10 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/import/stackage.scm
View file

@ -32,6 +32,8 @@ (define-module (guix import stackage)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module (guix diagnostics)
#:use-module (guix i18n)
#:export (%stackage-url #:export (%stackage-url
stackage->guix-package stackage->guix-package
stackage-recursive-import stackage-recursive-import
@ -71,9 +73,6 @@ (define-json-mapping <stackage-package> make-stackage-package
(version stackage-package-version) (version stackage-package-version)
(synopsis stackage-package-synopsis)) (synopsis stackage-package-synopsis))
(define (leave-with-message fmt . args)
(raise (condition (&message (message (apply format #f fmt args))))))
(define stackage-lts-info-fetch (define stackage-lts-info-fetch
;; "Retrieve the information about the LTS Stackage release VERSION." ;; "Retrieve the information about the LTS Stackage release VERSION."
(memoize (memoize
@ -84,7 +83,8 @@ (define stackage-lts-info-fetch
version))) version)))
(lts-info (and=> (json-fetch url) json->stackage-lts))) (lts-info (and=> (json-fetch url) json->stackage-lts)))
(or lts-info (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) (define (lts-package-version packages name)
"Return the version of the package with upstream NAME included in PACKAGES." "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 (hackage->guix-package name-version
#:include-test-dependencies? #:include-test-dependencies?
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) (define (stackage-recursive-import package-name . args)
(recursive-import package-name (recursive-import package-name
@ -145,10 +146,10 @@ (define latest-lts-release
(version (lts-package-version (packages) hackage-name)) (version (lts-package-version (packages) hackage-name))
(name-version (hackage-name-version hackage-name version))) (name-version (hackage-name-version hackage-name version)))
(match (and=> name-version hackage-fetch) (match (and=> name-version hackage-fetch)
(#f (format (current-error-port) (#f
"warning: failed to parse ~a~%" (warning (G_ "failed to parse ~a~%")
(hackage-cabal-url hackage-name)) (hackage-cabal-url hackage-name))
#f) #f)
(_ (let ((url (hackage-source-url hackage-name version))) (_ (let ((url (hackage-source-url hackage-name version)))
(upstream-source (upstream-source
(package (package-name package)) (package (package-name package))