guix/import/texlive.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix import texlive)
  20   #:use-module (ice-9 match)
  21   #:use-module (sxml simple)
  22   #:use-module (sxml xpath)
  23   #:use-module (srfi srfi-11)
  24   #:use-module (srfi srfi-1)
  25   #:use-module (srfi srfi-26)
  26   #:use-module (srfi srfi-34)
  27   #:use-module (web uri)
  28   #:use-module (guix http-client)
  29   #:use-module (gcrypt hash)
  30   #:use-module (guix memoization)
  31   #:use-module (guix store)
  32   #:use-module (guix base32)
  33   #:use-module (guix serialization)
  34   #:use-module (guix svn-download)
  35   #:use-module (guix import utils)
  36   #:use-module (guix utils)
  37   #:use-module (guix upstream)
  38   #:use-module (guix packages)
  39   #:use-module (gnu packages)
  40   #:use-module (guix build-system texlive)
  41   #:export (texlive->guix-package))
  42
  43 ;;; Commentary:
  44 ;;;
  45 ;;; Generate a package declaration template for the latest version of a
  46 ;;; package on CTAN, using the XML output produced by the XML API to the CTAN
  47 ;;; database at http://www.ctan.org/xml/1.2/
  48 ;;;
  49 ;;; Instead of taking the packages from CTAN, however, we fetch the sources
  50 ;;; from the SVN repository of the Texlive project.  We do this because CTAN
  51 ;;; only keeps a single version of each package whereas we can access any
  52 ;;; version via SVN.  Unfortunately, this means that the importer is really
  53 ;;; just a Texlive importer, not a generic CTAN importer.
  54 ;;;
  55 ;;; Code:
  56
  57 (define string->license
  58   (match-lambda
  59     ("artistic2" 'gpl3+)
  60     ("gpl" 'gpl3+)
  61     ("gpl1" 'gpl1)
  62     ("gpl1+" 'gpl1+)
  63     ("gpl2" 'gpl2)
  64     ("gpl2+" 'gpl2+)
  65     ("gpl3" 'gpl3)
  66     ("gpl3+" 'gpl3+)
  67     ("lgpl2.1" 'lgpl2.1)
  68     ("lgpl3" 'lgpl3)
  69     ("knuth" 'knuth)
  70     ("pd" 'public-domain)
  71     ("bsd2" 'bsd-2)
  72     ("bsd3" 'bsd-3)
  73     ("bsd4" 'bsd-4)
  74     ("opl" 'opl1.0+)
  75     ("ofl" 'silofl1.1)
  76     ("lppl" 'lppl)
  77     ("lppl1" 'lppl1.0+) ; usually means "or later"
  78     ("lppl1.2" 'lppl1.2+) ; usually means "or later"
  79     ("lppl1.3" 'lppl1.3+) ; usually means "or later"
  80     ("lppl1.3a" 'lppl1.3a)
  81     ("lppl1.3b" 'lppl1.3b)
  82     ("lppl1.3c" 'lppl1.3c)
  83     ("cc-by-2" 'cc-by-2.0)
  84     ("cc-by-3" 'cc-by-3.0)
  85     ("cc-by-sa-2" 'cc-by-sa2.0)
  86     ("cc-by-sa-3" 'cc-by-sa3.0)
  87     ("mit" 'expat)
  88     ("fdl" 'fdl1.3+)
  89     ("gfl" 'gfl1.0)
  90
  91     ;; These are known non-free licenses
  92     ("noinfo" 'unknown)
  93     ("nosell" 'non-free)
  94     ("shareware" 'non-free)
  95     ("nosource" 'non-free)
  96     ("nocommercial" 'non-free)
  97     ("cc-by-nc-nd-1" 'non-free)
  98     ("cc-by-nc-nd-2" 'non-free)
  99     ("cc-by-nc-nd-2.5" 'non-free)
 100     ("cc-by-nc-nd-3" 'non-free)
 101     ("cc-by-nc-nd-4" 'non-free)
 102     ((x) (string->license x))
 103     ((lst ...) `(list ,@(map string->license lst)))
 104     (_ #f)))
 105
 106 (define (fetch-sxml name)
 107   "Return an sxml representation of the package information contained in the
 108 XML description of the CTAN package or #f in case of failure."
 109   ;; This API always returns the latest release of the module.
 110   (let ((url (string-append "http://www.ctan.org/xml/1.2/pkg/" name)))
 111     (guard (c ((http-get-error? c)
 112                (format (current-error-port)
 113                        "error: failed to retrieve package information \
 114 from ~s: ~a (~s)~%"
 115                        (uri->string (http-get-error-uri c))
 116                        (http-get-error-code c)
 117                        (http-get-error-reason c))
 118                #f))
 119       (xml->sxml (http-fetch url)
 120                  #:trim-whitespace? #t))))
 121
 122 (define (guix-name component name)
 123   "Return a Guix package name for a given Texlive package NAME."
 124   (string-append "texlive-" component "-"
 125                  (string-map (match-lambda
 126                                (#\_ #\-)
 127                                (#\. #\-)
 128                                (chr (char-downcase chr)))
 129                              name)))
 130
 131 (define* (sxml->package sxml #:optional (component "latex"))
 132   "Return the `package' s-expression for a Texlive package from the SXML
 133 expression describing it."
 134   (define (sxml-value path)
 135     (match ((sxpath path) sxml)
 136       (() #f)
 137       ((val) val)))
 138   (with-store store
 139     (let* ((id         (sxml-value '(entry @ id *text*)))
 140            (synopsis   (sxml-value '(entry caption *text*)))
 141            (version    (or (sxml-value '(entry version @ number *text*))
 142                            (sxml-value '(entry version @ date *text*))))
 143            (license    (string->license (sxml-value '(entry license @ type *text*))))
 144            (home-page  (string-append "http://www.ctan.org/pkg/" id))
 145            (ref        (texlive-ref component id))
 146            (checkout   (download-svn-to-store store ref)))
 147       `(package
 148          (name ,(guix-name component id))
 149          (version ,version)
 150          (source (origin
 151                    (method svn-fetch)
 152                    (uri (texlive-ref ,component ,id))
 153                    (sha256
 154                     (base32
 155                      ,(bytevector->nix-base32-string
 156                        (let-values (((port get-hash) (open-sha256-port)))
 157                          (write-file checkout port)
 158                          (force-output port)
 159                          (get-hash)))))))
 160          (build-system texlive-build-system)
 161          (arguments ,`(,'quote (#:tex-directory ,(string-join (list component id) "/"))))
 162          (home-page ,home-page)
 163          (synopsis ,synopsis)
 164          (description ,(string-trim-both
 165                         (string-join
 166                          (map string-trim-both
 167                               (string-split
 168                                (beautify-description
 169                                 (sxml->string (or (sxml-value '(entry description))
 170                                                   '())))
 171                                #\newline)))))
 172          (license ,license)))))
 173
 174 (define texlive->guix-package
 175   (memoize
 176    (lambda* (package-name #:optional (component "latex"))
 177      "Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
 178 s-expression corresponding to that package, or #f on failure."
 179      (and=> (fetch-sxml package-name)
 180             (cut sxml->package <> component)))))
 181
 182 ;;; ctan.scm ends here