import: hackage: Support recursive importing.

* guix/import/hackage.scm (hackage-recursive-import): New procedure.
(hackage-module->sexp): Return dependencies alongside dependencies.
(hackage->guix-package): Memoize results.
* guix/scripts/import/hackage.scm (show-help, %options, guix-import-hackage):
Support recursive importing.
* doc/guix.texi (Invoking guix import): Document option.
This commit is contained in:
Ricardo Wurmus 2018-08-08 15:29:18 +02:00 committed by Ricardo Wurmus
parent 424fd76828
commit a928596162
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
3 changed files with 102 additions and 64 deletions

View File

@ -6661,6 +6661,11 @@ The value associated with a flag has to be either the symbol
has to conform to the Cabal file format definition. The default value
associated with the keys @code{os}, @code{arch} and @code{impl} is
@samp{linux}, @samp{x86_64} and @samp{ghc}, respectively.
@item --recursive
@itemx -r
Traverse the dependency graph of the given upstream package recursively
and generate package expressions for all those packages that are not yet
in Guix.
@end table
The command below imports metadata for the latest version of the

View File

@ -30,15 +30,17 @@
#:use-module ((guix utils) #:select (package-name->name+version
canonical-newline-port))
#:use-module (guix http-client)
#:use-module ((guix import utils) #:select (factorize-uri))
#:use-module ((guix import utils) #:select (factorize-uri recursive-import))
#:use-module (guix import cabal)
#:use-module (guix store)
#:use-module (guix hash)
#:use-module (guix base32)
#:use-module (guix memoization)
#:use-module (guix upstream)
#:use-module (guix packages)
#:use-module ((guix utils) #:select (call-with-temporary-output-file))
#:export (hackage->guix-package
hackage-recursive-import
%hackage-updater
guix-package->hackage-name
@ -205,20 +207,13 @@ representation of a Cabal file as produced by 'read-cabal'."
(define source-url
(hackage-source-url name version))
(define dependencies
(let ((names
(map hackage-name->package-name
(define hackage-dependencies
((compose (cut filter-dependencies <>
(cabal-package-name cabal))
(cut cabal-dependencies->names <>))
cabal))))
(map (lambda (name)
(list name (list 'unquote (string->symbol name))))
names)))
cabal))
(define native-dependencies
(let ((names
(map hackage-name->package-name
(define hackage-native-dependencies
((compose (cut filter-dependencies <>
(cabal-package-name cabal))
;; FIXME: Check include-test-dependencies?
@ -227,10 +222,19 @@ representation of a Cabal file as produced by 'read-cabal'."
(cabal-test-dependencies->names cabal)
'())
(cabal-custom-setup-dependencies->names cabal))))
cabal))))
cabal))
(define dependencies
(map (lambda (name)
(list name (list 'unquote (string->symbol name))))
names)))
(map hackage-name->package-name
hackage-dependencies)))
(define native-dependencies
(map (lambda (name)
(list name (list 'unquote (string->symbol name))))
(map hackage-name->package-name
hackage-native-dependencies)))
(define (maybe-inputs input-type inputs)
(match inputs
@ -247,6 +251,7 @@ representation of a Cabal file as produced by 'read-cabal'."
(let ((tarball (with-store store
(download-to-store store source-url))))
(values
`(package
(name ,(hackage-name->package-name name))
(version ,version)
@ -265,9 +270,12 @@ representation of a Cabal file as produced by 'read-cabal'."
(home-page ,(cabal-package-home-page cabal))
(synopsis ,(cabal-package-synopsis cabal))
(description ,(cabal-package-description cabal))
(license ,(string->license (cabal-package-license cabal))))))
(license ,(string->license (cabal-package-license cabal))))
(append hackage-dependencies hackage-native-dependencies))))
(define* (hackage->guix-package package-name #:key
(define hackage->guix-package
(memoize
(lambda* (package-name #:key
(include-test-dependencies? #t)
(port #f)
(cabal-environment '()))
@ -287,7 +295,13 @@ respectively."
(and=> cabal-meta (compose (cut hackage-module->sexp <>
#:include-test-dependencies?
include-test-dependencies?)
(cut eval-cabal <> cabal-environment)))))
(cut eval-cabal <> cabal-environment)))))))
(define* (hackage-recursive-import package-name . args)
(recursive-import package-name #f
#:repo->guix-package (lambda (name repo)
(apply hackage->guix-package (cons name args)))
#:guix-name hackage-name->package-name))
(define (hackage-package? package)
"Return #t if PACKAGE is a Haskell package from Hackage."

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -26,6 +27,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-37)
#:use-module (srfi srfi-41)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-import-hackage))
@ -57,6 +59,8 @@ version.\n"))
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
-r, --recursive import packages recursively"))
(display (G_ "
-s, --stdin read from standard input"))
(display (G_ "
-t, --no-test-dependencies don't include test-only dependencies"))
@ -89,6 +93,9 @@ version.\n"))
(alist-cons 'cabal-environment (read/eval arg)
(alist-delete 'cabal-environment
result))))
(option '(#\r "recursive") #f #f
(lambda (opt name arg result)
(alist-cons 'recursive #t result)))
%standard-import-options))
@ -107,7 +114,7 @@ version.\n"))
%default-options))
(define (run-importer package-name opts error-fn)
(let ((sexp (hackage->guix-package
(let* ((arguments (list
package-name
#:include-test-dependencies?
(assoc-ref opts 'include-test-dependencies?)
@ -115,7 +122,19 @@ version.\n"))
(current-input-port)
#f)
#:cabal-environment
(assoc-ref opts 'cabal-environment))))
(assoc-ref opts 'cabal-environment)))
(sexp (if (assoc-ref opts 'recursive)
;; Recursive import
(map (match-lambda
((and ('package ('name name) . rest) pkg)
`(define-public ,(string->symbol name)
,pkg))
(_ #f))
(reverse
(stream->list
(apply hackage-recursive-import arguments))))
;; Single import
(apply hackage->guix-package arguments))))
(unless sexp (error-fn))
sexp))