From 015f17e8b9eff97f656852180ac51c75438d7f9d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 12 Jun 2017 17:11:22 +0200 Subject: derivations: Introduce 'read-derivation-from-file'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This avoids the open/fstat/close syscalls upon a cache hit that we had with the previous idiom: (call-with-input-file file read-derivation) where caching happened in 'read-derivation' itself. * guix/derivations.scm (%read-derivation): Rename to... (read-derivation): ... this. (read-derivation-from-file): New procedure. (derivation-prerequisites, substitution-oracle) (derivation-prerequisites-to-build): (derivation-path->output-path, derivation-path->output-paths): (derivation-path->base16-hash, map-derivation): Use 'read-derivation-from-file' instead of (call-with-input-file … read-derivation). * guix/grafts.scm (item->deriver): Likewise. * guix/scripts/build.scm (log-url, options->things-to-build): Likewise. * guix/scripts/graph.scm (file->derivation): Remove. (derivation-dependencies, %derivation-node-type): Use 'read-derivation-from-file' instead. * guix/scripts/offload.scm (guix-offload): Likewise. * guix/scripts/perform-download.scm (guix-perform-download): Likewise. * guix/scripts/publish.scm (load-derivation): Remove. (narinfo-string): Use 'read-derivation-from-file'. --- guix/scripts/build.scm | 4 ++-- guix/scripts/graph.scm | 8 ++------ guix/scripts/offload.scm | 5 ++--- guix/scripts/perform-download.scm | 4 ++-- guix/scripts/publish.scm | 6 +----- 5 files changed, 9 insertions(+), 18 deletions(-) (limited to 'guix/scripts') 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 objects and store items corresponding to the dependencies of OBJ, a 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/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/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)))) -- cgit v1.2.3 From 4e863eb35fd8337eab48928e7733b7f6b7b2c242 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 13 Jun 2017 23:04:05 +0200 Subject: guix package: '--search' sorts by relevance. * guix/scripts/package.scm (find-packages-by-description): Rewrite to compute a score based on the number of regexps matched and the number of matches for each regexp. Sort according to this score and return it as a second value. (process-query) <'search>: Capture the two return values of 'find-packages-by-description'. Pass #:extra-fields to 'package->recutils'. * doc/guix.texi (Invoking guix package): Mention relevance, give an example. --- doc/guix.texi | 14 ++++++--- guix/scripts/package.scm | 76 ++++++++++++++++++++++++++++++------------------ 2 files changed, 58 insertions(+), 32 deletions(-) (limited to 'guix/scripts') diff --git a/doc/guix.texi b/doc/guix.texi index ffd2028de9..b5538e0195 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1854,7 +1854,7 @@ availability of packages: @itemx -s @var{regexp} @cindex searching for packages List the available packages whose name, synopsis, or description matches -@var{regexp}. Print all the metadata of matching packages in +@var{regexp}, sorted by relevance. Print all the metadata of matching packages in @code{recutils} format (@pxref{Top, GNU recutils databases,, recutils, GNU recutils manual}). @@ -1862,12 +1862,18 @@ This allows specific fields to be extracted using the @command{recsel} command, for instance: @example -$ guix package -s malloc | recsel -p name,version +$ guix package -s malloc | recsel -p name,version,relevance +name: jemalloc +version: 4.5.0 +relevance: 6 + name: glibc -version: 2.17 +version: 2.25 +relevance: 1 name: libgc -version: 7.2alpha6 +version: 7.6.0 +relevance: 1 @end example Similarly, to show the name of all the packages available under the 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=?)) - - (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-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) -- cgit v1.2.3 From afbc94194e223378dd3aece6e2330015e5e57a1e Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 9 Jun 2017 12:35:50 +0200 Subject: guix: Add texlive importer. * guix/import/texlive.scm: New file. * guix/scripts/import/texlive.scm: New file. * Makefile.am (MODULES): Add them. * tests/texlive.scm: New file. * Makefile.am (SCM_TESTS): Add it. * guix/scripts/import.scm (importers): Add texlive importer. * doc/guix.texi (Invoking guix import): Document it. --- Makefile.am | 3 + doc/guix.texi | 34 +++++++- guix/import/texlive.scm | 182 ++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/texlive.scm | 101 ++++++++++++++++++++++ tests/texlive.scm | 115 +++++++++++++++++++++++++ 6 files changed, 435 insertions(+), 2 deletions(-) create mode 100644 guix/import/texlive.scm create mode 100644 guix/scripts/import/texlive.scm create mode 100644 tests/texlive.scm (limited to 'guix/scripts') diff --git a/Makefile.am b/Makefile.am index 436a003411..4dfcd06d0b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -145,6 +145,7 @@ MODULES = \ guix/import/cran.scm \ guix/import/hackage.scm \ guix/import/elpa.scm \ + guix/import/texlive.scm \ guix/scripts.scm \ guix/scripts/download.scm \ guix/scripts/perform-download.scm \ @@ -167,6 +168,7 @@ MODULES = \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ guix/scripts/import/elpa.scm \ + guix/scripts/import/texlive.scm \ guix/scripts/environment.scm \ guix/scripts/publish.scm \ guix/scripts/edit.scm \ @@ -303,6 +305,7 @@ SCM_TESTS = \ tests/hackage.scm \ tests/cran.scm \ tests/elpa.scm \ + tests/texlive.scm \ tests/store.scm \ tests/monads.scm \ tests/gexp.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 056059d04b..97fa1b7864 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -21,7 +21,7 @@ Copyright @copyright{} 2015, 2016 Mathieu Lirzin@* Copyright @copyright{} 2014 Pierre-Antoine Rault@* Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@* Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@* -Copyright @copyright{} 2015, 2016 Ricardo Wurmus@* +Copyright @copyright{} 2015, 2016, 2017 Ricardo Wurmus@* Copyright @copyright{} 2016 Ben Woodcroft@* Copyright @copyright{} 2016 Chris Marusich@* Copyright @copyright{} 2016, 2017 Efraim Flashner@* @@ -5671,6 +5671,38 @@ R package: guix import cran --archive=bioconductor GenomicRanges @end example +@item texlive +@cindex TeX Live +@cindex CTAN +Import metadata from @uref{http://www.ctan.org/, CTAN}, the +comprehensive TeX archive network for TeX packages that are part of the +@uref{https://www.tug.org/texlive/, TeX Live distribution}. + +Information about the package is obtained through the XML API provided +by CTAN, while the source code is downloaded from the SVN repository of +the Tex Live project. This is done because the CTAN does not keep +versioned archives. + +The command command below imports metadata for the @code{fontspec} +TeX package: + +@example +guix import texlive fontspec +@end example + +When @code{--archive=DIRECTORY} is added, the source code is downloaded +not from the @file{latex} sub-directory of the @file{texmf-dist/source} +tree in the TeX Live SVN repository, but from the specified sibling +directory under the same root. + +The command below imports metadata for the @code{ifxetex} package from +CTAN while fetching the sources from the directory +@file{texmf/source/generic}: + +@example +guix import texlive --archive=generic ifxetex +@end example + @item nix Import metadata from a local copy of the source of the @uref{http://nixos.org/nixpkgs/, Nixpkgs distribution}@footnote{This diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm new file mode 100644 index 0000000000..d4c3714364 --- /dev/null +++ b/guix/import/texlive.scm @@ -0,0 +1,182 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ricardo Wurmus +;;; +;;; 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 . + +(define-module (guix import texlive) + #:use-module (ice-9 match) + #:use-module (sxml simple) + #:use-module (sxml xpath) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (web uri) + #:use-module (guix http-client) + #:use-module (guix hash) + #:use-module (guix memoization) + #:use-module (guix store) + #:use-module (guix base32) + #:use-module (guix serialization) + #:use-module (guix svn-download) + #:use-module (guix import utils) + #:use-module (guix utils) + #:use-module (guix upstream) + #:use-module (guix packages) + #:use-module (gnu packages) + #:use-module (guix build-system texlive) + #:export (texlive->guix-package)) + +;;; Commentary: +;;; +;;; Generate a package declaration template for the latest version of a +;;; package on CTAN, using the XML output produced by the XML API to the CTAN +;;; database at http://www.ctan.org/xml/1.2/ +;;; +;;; Instead of taking the packages from CTAN, however, we fetch the sources +;;; from the SVN repository of the Texlive project. We do this because CTAN +;;; only keeps a single version of each package whereas we can access any +;;; version via SVN. Unfortunately, this means that the importer is really +;;; just a Texlive importer, not a generic CTAN importer. +;;; +;;; Code: + +(define string->license + (match-lambda + ("artistic2" 'gpl3+) + ("gpl" 'gpl3+) + ("gpl1" 'gpl1) + ("gpl1+" 'gpl1+) + ("gpl2" 'gpl2) + ("gpl2+" 'gpl2+) + ("gpl3" 'gpl3) + ("gpl3+" 'gpl3+) + ("lgpl2.1" 'lgpl2.1) + ("lgpl3" 'lgpl3) + ("knuth" 'knuth) + ("pd" 'public-domain) + ("bsd2" 'bsd-2) + ("bsd3" 'bsd-3) + ("bsd4" 'bsd-4) + ("opl" 'opl1.0+) + ("ofl" 'silofl1.1) + ("lppl" 'lppl) + ("lppl1" 'lppl1.0+) ; usually means "or later" + ("lppl1.2" 'lppl1.2+) ; usually means "or later" + ("lppl1.3" 'lppl1.3+) ; usually means "or later" + ("lppl1.3a" 'lppl1.3a) + ("lppl1.3b" 'lppl1.3b) + ("lppl1.3c" 'lppl1.3c) + ("cc-by-2" 'cc-by-2.0) + ("cc-by-3" 'cc-by-3.0) + ("cc-by-sa-2" 'cc-by-sa2.0) + ("cc-by-sa-3" 'cc-by-sa3.0) + ("mit" 'expat) + ("fdl" 'fdl1.3+) + ("gfl" 'gfl1.0) + + ;; These are known non-free licenses + ("noinfo" 'unknown) + ("nosell" 'non-free) + ("shareware" 'non-free) + ("nosource" 'non-free) + ("nocommercial" 'non-free) + ("cc-by-nc-nd-1" 'non-free) + ("cc-by-nc-nd-2" 'non-free) + ("cc-by-nc-nd-2.5" 'non-free) + ("cc-by-nc-nd-3" 'non-free) + ("cc-by-nc-nd-4" 'non-free) + ((x) (string->license x)) + ((lst ...) `(list ,@(map string->license lst))) + (_ #f))) + +(define (fetch-sxml name) + "Return an sxml representation of the package information contained in the +XML description of the CTAN package or #f in case of failure." + ;; This API always returns the latest release of the module. + (let ((url (string-append "http://www.ctan.org/xml/1.2/pkg/" name))) + (guard (c ((http-get-error? c) + (format (current-error-port) + "error: failed to retrieve package information \ +from ~s: ~a (~s)~%" + (uri->string (http-get-error-uri c)) + (http-get-error-code c) + (http-get-error-reason c)) + #f)) + (xml->sxml (http-fetch url) + #:trim-whitespace? #t)))) + +(define (guix-name component name) + "Return a Guix package name for a given Texlive package NAME." + (string-append "texlive-" component "-" + (string-map (match-lambda + (#\_ #\-) + (#\. #\-) + (chr (char-downcase chr))) + name))) + +(define* (sxml->package sxml #:optional (component "latex")) + "Return the `package' s-expression for a Texlive package from the SXML +expression describing it." + (define (sxml-value path) + (match ((sxpath path) sxml) + (() #f) + ((val) val))) + (with-store store + (let* ((id (sxml-value '(entry @ id *text*))) + (synopsis (sxml-value '(entry caption *text*))) + (version (or (sxml-value '(entry version @ number *text*)) + (sxml-value '(entry version @ date *text*)))) + (license (string->license (sxml-value '(entry license @ type *text*)))) + (home-page (string-append "http://www.ctan.org/pkg/" id)) + (ref (texlive-ref component id)) + (checkout (download-svn-to-store store ref))) + `(package + (name ,(guix-name component id)) + (version ,version) + (source (origin + (method svn-fetch) + (uri (texlive-ref ,component ,id)) + (sha256 + (base32 + ,(bytevector->nix-base32-string + (let-values (((port get-hash) (open-sha256-port))) + (write-file checkout port) + (force-output port) + (get-hash))))))) + (build-system texlive-build-system) + (arguments ,`(,'quote (#:tex-directory ,(string-join (list component id) "/")))) + (home-page ,home-page) + (synopsis ,synopsis) + (description ,(string-trim-both + (string-join + (map string-trim-both + (string-split + (beautify-description + (sxml->string (or (sxml-value '(entry description)) + '()))) + #\newline))))) + (license ,license))))) + +(define texlive->guix-package + (memoize + (lambda* (package-name #:optional (component "latex")) + "Fetch the metadata for PACKAGE-NAME from REPO and return the `package' +s-expression corresponding to that package, or #f on failure." + (and=> (fetch-sxml package-name) + (cut sxml->package <> component))))) + +;;; ctan.scm ends here 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 +;;; +;;; 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 . + +(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/tests/texlive.scm b/tests/texlive.scm new file mode 100644 index 0000000000..e28eda175c --- /dev/null +++ b/tests/texlive.scm @@ -0,0 +1,115 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ricardo Wurmus +;;; +;;; 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 . + +(define-module (test-texlive) + #:use-module (gnu packages tex) + #:use-module (guix import texlive) + #:use-module (guix tests) + #:use-module (guix build utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match)) + +(test-begin "texlive") + +(define xml + "\ + + foo + Foomatic frobnication in LuaLaTeX + + + + +

+ Foo is a package for LuaLaTeX. It provides an interface to frobnicate gimbals + in a foomatic way with the LuaTeX engine. +

+

+ The package requires the bar and golly + bundles for extremely special specialties. +

+ + + + + null +") + +(define sxml + '(*TOP* (entry (@ (id "foo")) + (name "foo") + (caption "Foomatic frobnication in LuaLaTeX") + (authorref (@ (id "rekado"))) + (license (@ (type "lppl1.3"))) + (version (@ (number "2.6a"))) + (description + (p "\n Foo is a package for LuaLaTeX. It provides an interface to frobnicate gimbals\n in a foomatic way with the LuaTeX engine.\n ") + (p "\n The package requires the bar and golly\n bundles for extremely special specialties.\n ")) + (ctan (@ (path "/macros/latex/contrib/foo") (file "true"))) + (texlive (@ (location "foo"))) + (keyval (@ (value "tests") (key "topic"))) + "\n null\n"))) + +(test-equal "fetch-sxml: returns SXML for valid XML" + sxml + (mock ((guix http-client) http-fetch + (lambda (url) + xml)) + ((@@ (guix import texlive) fetch-sxml) "foo"))) + +;; TODO: +(test-assert "sxml->package" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result ((@@ (guix import texlive) sxml->package) sxml))) + (match result + (('package + ('name "texlive-latex-foo") + ('version "2.6a") + ('source ('origin + ('method 'svn-fetch) + ('uri ('texlive-ref "latex" "foo")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'texlive-build-system) + ('arguments ('quote (#:tex-directory "latex/foo"))) + ('home-page "http://www.ctan.org/pkg/foo") + ('synopsis "Foomatic frobnication in LuaLaTeX") + ('description + "Foo is a package for LuaLaTeX. It provides an interface to \ +frobnicate gimbals in a foomatic way with the LuaTeX engine. The package \ +requires the bar and golly bundles for extremely special specialties.") + ('license 'lppl1.3+)) + #t) + (_ + (begin + (format #t "~s\n" result) + (pk 'fail result #f))))))) + +(test-end "texlive") -- cgit v1.2.3