diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/build.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/graph.scm | 8 | ||||
| -rw-r--r-- | guix/scripts/import.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/import/texlive.scm | 101 | ||||
| -rw-r--r-- | guix/scripts/offload.scm | 5 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 76 | ||||
| -rw-r--r-- | guix/scripts/perform-download.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/publish.scm | 6 |
8 files changed, 159 insertions, 47 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 558e8e7719..0571b874f1 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -87,7 +87,7 @@ found. Return #f if no build log was found." ;; Usually we'll have more luck with the output file name since ;; the deriver that was used by the server could be different, so ;; try one of the output file names. - (let ((drv (call-with-input-file file read-derivation))) + (let ((drv (read-derivation-from-file file))) (or (find-url (derivation->output-path drv)) (find-url file)))) (lambda args @@ -599,7 +599,7 @@ build---packages, gexps, derivations, and so on." (append-map (match-lambda (('argument . (? string? spec)) (cond ((derivation-path? spec) - (list (call-with-input-file spec read-derivation))) + (list (read-derivation-from-file spec))) ((store-path? spec) ;; Nothing to do; maybe for --log-file. '()) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 0af1fa3ad3..d5be442884 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -221,15 +221,11 @@ GNU-BUILD-SYSTEM have zero dependencies." ;;; Derivation DAG. ;;; -(define (file->derivation file) - "Read the derivation from FILE and return it." - (call-with-input-file file read-derivation)) - (define (derivation-dependencies obj) "Return the <derivation> objects and store items corresponding to the dependencies of OBJ, a <derivation> or store item." (if (derivation? obj) - (append (map (compose file->derivation derivation-input-path) + (append (map (compose read-derivation-from-file derivation-input-path) (derivation-inputs obj)) (derivation-sources obj)) '())) @@ -263,7 +259,7 @@ a plain store file." ((? derivation-path? item) (mbegin %store-monad ((store-lift add-temp-root) item) - (return (list (file->derivation item))))) + (return (list (read-derivation-from-file item))))) (x (raise (condition (&message (message "unsupported argument for \ diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 203cda8049..9bba074e8c 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -74,7 +74,7 @@ rather than \\n." ;;; (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem" - "cran" "crate")) + "cran" "crate" "texlive")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/texlive.scm b/guix/scripts/import/texlive.scm new file mode 100644 index 0000000000..1cceee7051 --- /dev/null +++ b/guix/scripts/import/texlive.scm @@ -0,0 +1,101 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix scripts import texlive) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import texlive) + #:use-module (guix scripts import) + #: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-texlive)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (G_ "Usage: guix import texlive PACKAGE-NAME +Import and convert the Texlive package for PACKAGE-NAME.\n")) + (display (G_ " + -a, --archive=ARCHIVE specify the archive repository")) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import texlive"))) + (option '(#\a "archive") #t #f + (lambda (opt name arg result) + (alist-cons 'component arg + (alist-delete 'component result)))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-texlive . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (texlive->guix-package package-name + (or (assoc-ref opts 'component) + "latex")))) + (unless sexp + (leave (G_ "failed to download description for package '~a'~%") + package-name)) + sexp)) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 77b340cff6..566d117b02 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -652,9 +652,8 @@ machine." (with-error-handling (process-request (equal? (match:substring match 1) "1") (match:substring match 2) ; system - (call-with-input-file - (match:substring match 3) - read-derivation) + (read-derivation-from-file + (match:substring match 3)) (string-tokenize (match:substring match 4) not-coma) #:print-build-trace? print-build-trace? diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index f050fad976..a6bfb03ae4 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -39,6 +39,7 @@ #:select (directory-exists? mkdir-p)) #:use-module (ice-9 format) #:use-module (ice-9 match) + #:use-module (ice-9 regex) #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -238,32 +239,45 @@ specified in MANIFEST, a manifest object." ;;; (define (find-packages-by-description regexps) - "Return the list of packages whose name matches one of REGEXPS, or whose -synopsis or description matches all of REGEXPS." - (define version<? (negate version>=?)) - - (define (matches-all? str) - (every (cut regexp-exec <> str) regexps)) - - (define (matches-one? str) - (find (cut regexp-exec <> str) regexps)) - - (sort - (fold-packages (lambda (package result) - (if (or (matches-one? (package-name package)) - (and=> (package-synopsis package) - (compose matches-all? P_)) - (and=> (package-description package) - (compose matches-all? P_))) - (cons package result) - result)) - '()) - (lambda (p1 p2) - (case (string-compare (package-name p1) (package-name p2) - (const '<) (const '=) (const '>)) - ((=) (version<? (package-version p1) (package-version p2))) - ((<) #t) - (else #f))))) + "Return two values: the list of packages whose name, synopsis, or +description matches at least one of REGEXPS sorted by relevance, and the list +of relevance scores." + (define (score str) + (let ((counts (filter-map (lambda (regexp) + (match (regexp-exec regexp str) + (#f #f) + (m (match:count m)))) + regexps))) + ;; Compute a score that's proportional to the number of regexps matched + ;; and to the number of matches for each regexp. + (* (length counts) (reduce + 0 counts)))) + + (define (package-score package) + (+ (* 3 (score (package-name package))) + (* 2 (match (package-synopsis package) + ((? string? str) (score (P_ str))) + (#f 0))) + (match (package-description package) + ((? string? str) (score (P_ str))) + (#f 0)))) + + (let ((matches (fold-packages (lambda (package result) + (match (package-score package) + ((? zero?) + result) + (score + (cons (list package score) result)))) + '()))) + (unzip2 (sort matches + (lambda (m1 m2) + (match m1 + ((package1 score1) + (match m2 + ((package2 score2) + (if (= score1 score2) + (string>? (package-full-name package1) + (package-full-name package2)) + (> score1 score2))))))))))) (define (transaction-upgrade-entry entry transaction) "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a @@ -752,8 +766,14 @@ processed, #f otherwise." opts)) (regexps (map (cut make-regexp* <> regexp/icase) patterns))) (leave-on-EPIPE - (for-each (cute package->recutils <> (current-output-port)) - (find-packages-by-description regexps))) + (let-values (((packages scores) + (find-packages-by-description regexps))) + (for-each (lambda (package score) + (package->recutils package (current-output-port) + #:extra-fields + `((relevance . ,score)))) + packages + scores))) #t)) (('show requested-name) diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index aee506af46..18e2fc92f2 100644 --- a/guix/scripts/perform-download.scm +++ b/guix/scripts/perform-download.scm @@ -106,11 +106,11 @@ of GnuTLS over HTTPS, before we have built GnuTLS. See (match args (((? derivation-path? drv) (? store-path? output)) (assert-low-privileges) - (perform-download (call-with-input-file drv read-derivation) + (perform-download (read-derivation-from-file drv) output)) (((? derivation-path? drv)) ;backward compatibility (assert-low-privileges) - (perform-download (call-with-input-file drv read-derivation))) + (perform-download (read-derivation-from-file drv))) (("--version") (show-version-and-exit)) (x diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index c49c0c3e20..a7e3e6d629 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -225,10 +225,6 @@ compression disabled~%")) ("WantMassQuery" . 0) ("Priority" . 100))) -(define (load-derivation file) - "Read the derivation from FILE." - (call-with-input-file file read-derivation)) - (define (signed-string s) "Sign the hash of the string S with the daemon's key." (let* ((public-key (%public-key)) @@ -286,7 +282,7 @@ References: ~a~%~a" base-info (catch 'system-error (lambda () - (let ((drv (load-derivation deriver))) + (let ((drv (read-derivation-from-file deriver))) (format #f "~aSystem: ~a~%Deriver: ~a~%" base-info (derivation-system drv) (basename deriver)))) |