diff options
Diffstat (limited to 'guix')
-rw-r--r-- | guix/import/cran.scm | 4 | ||||
-rw-r--r-- | guix/import/crate.scm | 17 | ||||
-rw-r--r-- | guix/import/utils.scm | 84 | ||||
-rw-r--r-- | guix/scripts/import/cran.scm | 7 | ||||
-rw-r--r-- | guix/scripts/import/crate.scm | 5 | ||||
-rw-r--r-- | guix/scripts/import/elpa.scm | 7 | ||||
-rw-r--r-- | guix/scripts/import/gem.scm | 5 | ||||
-rw-r--r-- | guix/scripts/import/hackage.scm | 5 | ||||
-rw-r--r-- | guix/scripts/import/opam.scm | 5 | ||||
-rw-r--r-- | guix/scripts/import/pypi.scm | 5 | ||||
-rw-r--r-- | guix/scripts/import/stackage.scm | 5 |
11 files changed, 69 insertions, 80 deletions
diff --git a/guix/import/cran.scm b/guix/import/cran.scm index e47aff2b12..d9018cc7da 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net> -;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -505,7 +505,7 @@ s-expression corresponding to that package, or #f on failure." ((bioconductor) ;; Retry import from CRAN (cran->guix-package package-name 'cran)) - (else #f))))))) + (else (values #f '())))))))) (define* (cran-recursive-import package-name #:optional (repo 'cran)) (recursive-import package-name repo diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 8dc014d232..4c3f8000d0 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -178,21 +178,20 @@ and LICENSE." (close-port port) pkg)) -(define %dual-license-rx - ;; Dual licensing is represented by a string such as "MIT OR Apache-2.0". - ;; This regexp matches that. - (make-regexp "^(.*) OR (.*)$")) +(define (string->license string) + (filter-map (lambda (license) + (and (not (string-null? license)) + (not (any (lambda (elem) (string=? elem license)) + '("AND" "OR" "WITH"))) + (or (spdx-string->license license) + 'unknown-license!))) + (string-split string (string->char-set " /")))) (define* (crate->guix-package crate-name #:optional version) "Fetch the metadata for CRATE-NAME from crates.io, and return the `package' s-expression corresponding to that package, or #f on failure. When VERSION is specified, attempt to fetch that version; otherwise fetch the latest version of CRATE-NAME." - (define (string->license string) - (match (regexp-exec %dual-license-rx string) - (#f (list (spdx-string->license string))) - (m (list (spdx-string->license (match:substring m 1)) - (spdx-string->license (match:substring m 2)))))) (define (normal-dependency? dependency) (eq? (crate-dependency-kind dependency) 'normal)) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 4694b6e7ef..47fc8276a9 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -34,15 +34,16 @@ #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix download) + #:use-module (guix sets) #:use-module (gnu packages) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) #:use-module (ice-9 receive) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) - #:use-module (srfi srfi-41) #:export (factorize-uri flatten @@ -377,40 +378,53 @@ separated by PRED." (chr (char-downcase chr))) name))) +(define (topological-sort nodes + node-dependencies + node-name) + "Perform a breadth-first traversal of the graph rooted at NODES, a list of +nodes, and return the list of nodes sorted in topological order. Call +NODE-DEPENDENCIES to obtain the dependencies of a node, and NODE-NAME to +obtain a node's uniquely identifying \"key\"." + (let loop ((nodes nodes) + (result '()) + (visited (set))) + (match nodes + (() + result) + ((head . tail) + (if (set-contains? visited (node-name head)) + (loop tail result visited) + (let ((dependencies (node-dependencies head))) + (loop (append dependencies tail) + (cons head result) + (set-insert (node-name head) visited)))))))) + (define* (recursive-import package-name repo #:key repo->guix-package guix-name #:allow-other-keys) - "Generate a stream of package expressions for PACKAGE-NAME and all its -dependencies." - (define (exists? dependency) - (not (null? (find-packages-by-name (guix-name dependency))))) - (define initial-state (list #f (list package-name) (list))) - (define (step state) - (match state - ((prev (next . rest) done) - (define (handle? dep) - (and - (not (equal? dep next)) - (not (member dep done)) - (not (exists? dep)))) - (receive (package . dependencies) (repo->guix-package next repo) - (list - (if package package '()) ;; default #f on failure would interrupt - (if package - (lset-union equal? rest (filter handle? (car dependencies))) - rest) - (cons next done)))) - ((prev '() done) - (list #f '() done)))) - - ;; Generate a lazy stream of package expressions for all unknown - ;; dependencies in the graph. - (stream-unfold - ;; map: produce a stream element - (match-lambda ((latest queue done) latest)) - ;; predicate - (match-lambda ((latest queue done) latest)) - ;; generator: update the queue - step - ;; initial state - (step initial-state))) + "Return a stream of package expressions for PACKAGE-NAME and all its +dependencies, sorted in topological order. For each package, +call (REPO->GUIX-PACKAGE NAME REPO), which should return a package expression +and a list of dependencies; call (GUIX-NAME NAME) to obtain the Guix package +name corresponding to the upstream name." + (define-record-type <node> + (make-node name package dependencies) + node? + (name node-name) + (package node-package) + (dependencies node-dependencies)) + + (define (exists? name) + (not (null? (find-packages-by-name (guix-name name))))) + + (define (lookup-node name) + (receive (package dependencies) (repo->guix-package name repo) + (make-node name package dependencies))) + + (map node-package + (topological-sort (list (lookup-node package-name)) + (lambda (node) + (map lookup-node + (remove exists? + (node-dependencies node)))) + node-name))) diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm index b6592f78a9..d6f371ef3a 100644 --- a/guix/scripts/import/cran.scm +++ b/guix/scripts/import/cran.scm @@ -27,7 +27,6 @@ #: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-cran)) @@ -98,10 +97,8 @@ Import and convert the CRAN package for PACKAGE-NAME.\n")) (if (assoc-ref opts 'recursive) ;; Recursive import (map package->definition - (reverse - (stream->list - (cran-recursive-import package-name - (or (assoc-ref opts 'repo) 'cran))))) + (cran-recursive-import package-name + (or (assoc-ref opts 'repo) 'cran))) ;; Single import (let ((sexp (cran->guix-package package-name (or (assoc-ref opts 'repo) 'cran)))) diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index 4690cceb4d..92034dab3c 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -28,7 +28,6 @@ #: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-crate)) @@ -101,9 +100,7 @@ Import and convert the crate.io package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (crate-recursive-import name)))) + (crate-recursive-import name)) (let ((sexp (crate->guix-package name version))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm index f1ed5016ba..d270d2b4bc 100644 --- a/guix/scripts/import/elpa.scm +++ b/guix/scripts/import/elpa.scm @@ -27,7 +27,6 @@ #: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-elpa)) @@ -101,10 +100,8 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (elpa-recursive-import package-name - (or (assoc-ref opts 'repo) 'gnu))))) + (elpa-recursive-import package-name + (or (assoc-ref opts 'repo) 'gnu))) (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) (unless sexp (leave (G_ "failed to download package '~a'~%") package-name)) diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm index b6d9ccaae4..c64596b514 100644 --- a/guix/scripts/import/gem.scm +++ b/guix/scripts/import/gem.scm @@ -26,7 +26,6 @@ #: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-gem)) @@ -95,9 +94,7 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (gem-recursive-import package-name 'rubygems)))) + (gem-recursive-import package-name 'rubygems)) (let ((sexp (gem->guix-package package-name))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm index f4aac61078..710e786a79 100644 --- a/guix/scripts/import/hackage.scm +++ b/guix/scripts/import/hackage.scm @@ -27,7 +27,6 @@ #: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)) @@ -130,9 +129,7 @@ version.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (apply hackage-recursive-import arguments)))) + (apply hackage-recursive-import arguments)) ;; Single import (apply hackage->guix-package arguments)))) (unless sexp (error-fn)) diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm index 2d249a213f..20da1437fe 100644 --- a/guix/scripts/import/opam.scm +++ b/guix/scripts/import/opam.scm @@ -25,7 +25,6 @@ #: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-opam)) @@ -94,9 +93,7 @@ Import and convert the opam package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (opam-recursive-import package-name)))) + (opam-recursive-import package-name)) ;; Single import (let ((sexp (opam->guix-package package-name))) (unless sexp diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm index 7bd83818ba..33167174e2 100644 --- a/guix/scripts/import/pypi.scm +++ b/guix/scripts/import/pypi.scm @@ -26,7 +26,6 @@ #: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-pypi)) @@ -95,9 +94,7 @@ Import and convert the PyPI package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (pypi-recursive-import package-name)))) + (pypi-recursive-import package-name)) ;; Single import (let ((sexp (pypi->guix-package package-name))) (unless sexp diff --git a/guix/scripts/import/stackage.scm b/guix/scripts/import/stackage.scm index b4b12581bf..d77328dcbf 100644 --- a/guix/scripts/import/stackage.scm +++ b/guix/scripts/import/stackage.scm @@ -27,7 +27,6 @@ #: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-stackage)) @@ -110,9 +109,7 @@ Import and convert the LTS Stackage package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (apply stackage-recursive-import arguments)))) + (apply stackage-recursive-import arguments)) ;; Single import (apply stackage->guix-package arguments)))) (unless sexp (error-fn)) |