From a92859616201dbf0cec36d3c746125d645c88c79 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>
Date: Wed, 8 Aug 2018 15:29:18 +0200
Subject: [PATCH] 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.
---
doc/guix.texi | 5 ++
guix/import/hackage.scm | 124 ++++++++++++++++++--------------
guix/scripts/import/hackage.scm | 37 +++++++---
3 files changed, 102 insertions(+), 64 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 85f51210a31..a9bb6d864ac 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 3b138f8c98b..3c00f680bf7 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -30,15 +30,17 @@ (define-module (guix import hackage)
#: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,32 +207,34 @@ (define version
(define source-url
(hackage-source-url name version))
+ (define hackage-dependencies
+ ((compose (cut filter-dependencies <>
+ (cabal-package-name cabal))
+ (cut cabal-dependencies->names <>))
+ cabal))
+
+ (define hackage-native-dependencies
+ ((compose (cut filter-dependencies <>
+ (cabal-package-name cabal))
+ ;; FIXME: Check include-test-dependencies?
+ (lambda (cabal)
+ (append (if include-test-dependencies?
+ (cabal-test-dependencies->names cabal)
+ '())
+ (cabal-custom-setup-dependencies->names cabal))))
+ cabal))
+
(define dependencies
- (let ((names
- (map hackage-name->package-name
- ((compose (cut filter-dependencies <>
- (cabal-package-name cabal))
- (cut cabal-dependencies->names <>))
- cabal))))
- (map (lambda (name)
- (list name (list 'unquote (string->symbol name))))
- names)))
+ (map (lambda (name)
+ (list name (list 'unquote (string->symbol name))))
+ (map hackage-name->package-name
+ hackage-dependencies)))
(define native-dependencies
- (let ((names
- (map hackage-name->package-name
- ((compose (cut filter-dependencies <>
- (cabal-package-name cabal))
- ;; FIXME: Check include-test-dependencies?
- (lambda (cabal)
- (append (if include-test-dependencies?
- (cabal-test-dependencies->names cabal)
- '())
- (cabal-custom-setup-dependencies->names cabal))))
- cabal))))
- (map (lambda (name)
- (list name (list 'unquote (string->symbol name))))
- names)))
+ (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,31 +251,35 @@ (define (maybe-arguments)
(let ((tarball (with-store store
(download-to-store store source-url))))
- `(package
- (name ,(hackage-name->package-name name))
- (version ,version)
- (source (origin
- (method url-fetch)
- (uri (string-append ,@(factorize-uri source-url version)))
- (sha256
- (base32
- ,(if tarball
- (bytevector->nix-base32-string (file-sha256 tarball))
- "failed to download tar archive")))))
- (build-system haskell-build-system)
- ,@(maybe-inputs 'inputs dependencies)
- ,@(maybe-inputs 'native-inputs native-dependencies)
- ,@(maybe-arguments)
- (home-page ,(cabal-package-home-page cabal))
- (synopsis ,(cabal-package-synopsis cabal))
- (description ,(cabal-package-description cabal))
- (license ,(string->license (cabal-package-license cabal))))))
+ (values
+ `(package
+ (name ,(hackage-name->package-name name))
+ (version ,version)
+ (source (origin
+ (method url-fetch)
+ (uri (string-append ,@(factorize-uri source-url version)))
+ (sha256
+ (base32
+ ,(if tarball
+ (bytevector->nix-base32-string (file-sha256 tarball))
+ "failed to download tar archive")))))
+ (build-system haskell-build-system)
+ ,@(maybe-inputs 'inputs dependencies)
+ ,@(maybe-inputs 'native-inputs native-dependencies)
+ ,@(maybe-arguments)
+ (home-page ,(cabal-package-home-page cabal))
+ (synopsis ,(cabal-package-synopsis cabal))
+ (description ,(cabal-package-description cabal))
+ (license ,(string->license (cabal-package-license cabal))))
+ (append hackage-dependencies hackage-native-dependencies))))
-(define* (hackage->guix-package package-name #:key
- (include-test-dependencies? #t)
- (port #f)
- (cabal-environment '()))
- "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
+(define hackage->guix-package
+ (memoize
+ (lambda* (package-name #:key
+ (include-test-dependencies? #t)
+ (port #f)
+ (cabal-environment '()))
+ "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
called with keyword parameter PORT, from PORT. Return the `package'
S-expression corresponding to that package, or #f on failure.
CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal
@@ -281,13 +289,19 @@ (define* (hackage->guix-package package-name #:key
to the Cabal file format definition. The default value associated with the
keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\"
respectively."
- (let ((cabal-meta (if port
- (read-cabal (canonical-newline-port port))
- (hackage-fetch package-name))))
- (and=> cabal-meta (compose (cut hackage-module->sexp <>
- #:include-test-dependencies?
- include-test-dependencies?)
- (cut eval-cabal <> cabal-environment)))))
+ (let ((cabal-meta (if port
+ (read-cabal (canonical-newline-port port))
+ (hackage-fetch package-name))))
+ (and=> cabal-meta (compose (cut hackage-module->sexp <>
+ #:include-test-dependencies?
+ include-test-dependencies?)
+ (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."
diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm
index 969f6378467..f4aac610788 100644
--- a/guix/scripts/import/hackage.scm
+++ b/guix/scripts/import/hackage.scm
@@ -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 @@ (define-module (guix scripts import hackage)
#: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 @@ (define (show-help)
(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 @@ (define %options
(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,15 +114,27 @@ (define (parse-options)
%default-options))
(define (run-importer package-name opts error-fn)
- (let ((sexp (hackage->guix-package
- package-name
- #:include-test-dependencies?
- (assoc-ref opts 'include-test-dependencies?)
- #:port (if (assoc-ref opts 'read-from-stdin?)
- (current-input-port)
- #f)
- #:cabal-environment
- (assoc-ref opts 'cabal-environment))))
+ (let* ((arguments (list
+ package-name
+ #:include-test-dependencies?
+ (assoc-ref opts 'include-test-dependencies?)
+ #:port (if (assoc-ref opts 'read-from-stdin?)
+ (current-input-port)
+ #f)
+ #: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))
--
GitLab