me
/
guix
Archived
1
0
Fork 0
Code

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.
master
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
doc/guix.texi
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 has to conform to the Cabal file format definition. The default value
associated with the keys @code{os}, @code{arch} and @code{impl} is associated with the keys @code{os}, @code{arch} and @code{impl} is
@samp{linux}, @samp{x86_64} and @samp{ghc}, respectively. @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 @end table
The command below imports metadata for the latest version of the The command below imports metadata for the latest version of the

124
guix/import/hackage.scm
View File

@ -30,15 +30,17 @@
#:use-module ((guix utils) #:select (package-name->name+version #:use-module ((guix utils) #:select (package-name->name+version
canonical-newline-port)) canonical-newline-port))
#:use-module (guix http-client) #: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 import cabal)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix memoization)
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:use-module ((guix utils) #:select (call-with-temporary-output-file))
#:export (hackage->guix-package #:export (hackage->guix-package
hackage-recursive-import
%hackage-updater %hackage-updater
guix-package->hackage-name guix-package->hackage-name
@ -205,32 +207,34 @@ representation of a Cabal file as produced by 'read-cabal'."
(define source-url (define source-url
(hackage-source-url name version)) (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 (define dependencies
(let ((names (map (lambda (name)
(map hackage-name->package-name (list name (list 'unquote (string->symbol name))))
((compose (cut filter-dependencies <> (map hackage-name->package-name
(cabal-package-name cabal)) hackage-dependencies)))
(cut cabal-dependencies->names <>))
cabal))))
(map (lambda (name)
(list name (list 'unquote (string->symbol name))))
names)))
(define native-dependencies (define native-dependencies
(let ((names (map (lambda (name)
(map hackage-name->package-name (list name (list 'unquote (string->symbol name))))
((compose (cut filter-dependencies <> (map hackage-name->package-name
(cabal-package-name cabal)) hackage-native-dependencies)))
;; 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)))
(define (maybe-inputs input-type inputs) (define (maybe-inputs input-type inputs)
(match inputs (match inputs
@ -247,31 +251,35 @@ representation of a Cabal file as produced by 'read-cabal'."
(let ((tarball (with-store store (let ((tarball (with-store store
(download-to-store store source-url)))) (download-to-store store source-url))))
`(package (values
(name ,(hackage-name->package-name name)) `(package
(version ,version) (name ,(hackage-name->package-name name))
(source (origin (version ,version)
(method url-fetch) (source (origin
(uri (string-append ,@(factorize-uri source-url version))) (method url-fetch)
(sha256 (uri (string-append ,@(factorize-uri source-url version)))
(base32 (sha256
,(if tarball (base32
(bytevector->nix-base32-string (file-sha256 tarball)) ,(if tarball
"failed to download tar archive"))))) (bytevector->nix-base32-string (file-sha256 tarball))
(build-system haskell-build-system) "failed to download tar archive")))))
,@(maybe-inputs 'inputs dependencies) (build-system haskell-build-system)
,@(maybe-inputs 'native-inputs native-dependencies) ,@(maybe-inputs 'inputs dependencies)
,@(maybe-arguments) ,@(maybe-inputs 'native-inputs native-dependencies)
(home-page ,(cabal-package-home-page cabal)) ,@(maybe-arguments)
(synopsis ,(cabal-package-synopsis cabal)) (home-page ,(cabal-package-home-page cabal))
(description ,(cabal-package-description cabal)) (synopsis ,(cabal-package-synopsis cabal))
(license ,(string->license (cabal-package-license 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 (define hackage->guix-package
(include-test-dependencies? #t) (memoize
(port #f) (lambda* (package-name #:key
(cabal-environment '())) (include-test-dependencies? #t)
"Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the (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' called with keyword parameter PORT, from PORT. Return the `package'
S-expression corresponding to that package, or #f on failure. S-expression corresponding to that package, or #f on failure.
CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal
@ -281,13 +289,19 @@ symbol 'true' or 'false'. The value associated with other keys has to conform
to the Cabal file format definition. The default value associated with the to the Cabal file format definition. The default value associated with the
keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\" keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\"
respectively." respectively."
(let ((cabal-meta (if port (let ((cabal-meta (if port
(read-cabal (canonical-newline-port port)) (read-cabal (canonical-newline-port port))
(hackage-fetch package-name)))) (hackage-fetch package-name))))
(and=> cabal-meta (compose (cut hackage-module->sexp <> (and=> cabal-meta (compose (cut hackage-module->sexp <>
#:include-test-dependencies? #:include-test-dependencies?
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) (define (hackage-package? package)
"Return #t if PACKAGE is a Haskell package from Hackage." "Return #t if PACKAGE is a Haskell package from Hackage."

37
guix/scripts/import/hackage.scm
View File

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