guix/import/hackage.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
   3 ;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
   4 ;;; Copyright © 2016 ng0 <ng0@n0.is>
   5 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (guix import hackage)
  23   #:use-module (ice-9 match)
  24   #:use-module (ice-9 regex)
  25   #:use-module (srfi srfi-34)
  26   #:use-module (srfi srfi-26)
  27   #:use-module (srfi srfi-11)
  28   #:use-module (srfi srfi-1)
  29   #:use-module ((guix download) #:select (download-to-store url-fetch))
  30   #:use-module ((guix utils) #:select (package-name->name+version
  31                                        canonical-newline-port))
  32   #:use-module (guix http-client)
  33   #:use-module ((guix import utils) #:select (factorize-uri recursive-import))
  34   #:use-module (guix import cabal)
  35   #:use-module (guix store)
  36   #:use-module (gcrypt hash)
  37   #:use-module (guix base32)
  38   #:use-module (guix memoization)
  39   #:use-module (guix upstream)
  40   #:use-module (guix packages)
  41   #:use-module ((guix utils) #:select (call-with-temporary-output-file))
  42   #:export (hackage->guix-package
  43             hackage-recursive-import
  44             %hackage-updater
  45
  46             guix-package->hackage-name
  47             hackage-name->package-name
  48             hackage-fetch
  49             hackage-source-url
  50             hackage-cabal-url
  51             hackage-package?))
  52
  53 (define ghc-standard-libraries
  54   ;; List of libraries distributed with ghc (8.4.3).
  55   ;; https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/8.4.3-notes.html
  56   '("ghc"
  57     "cabal" ;; in the output of `ghc-pkg list` Cabal is uppercased, but
  58             ;; hackage-name->package-name takes this into account.
  59     "win32" ;; similarly uppercased
  60     "array"
  61     "base"
  62     "binary"
  63     "bytestring"
  64     "containers"
  65     "deepseq"
  66     "directory"
  67     "filepath"
  68     "ghc-boot"
  69     "ghc-compact"
  70     "ghc-prim"
  71     "ghci"
  72     "haskeline"
  73     "hpc"
  74     "integer-gmp"
  75     "mtl"
  76     "parsec"
  77     "process"
  78     "template-haskell"
  79     "text"
  80     "time"
  81     "transformers"
  82     "unix"
  83     "xhtml"))
  84
  85 (define package-name-prefix "ghc-")
  86
  87 (define (hackage-source-url name version)
  88   "Given a Hackage package NAME and VERSION, return a url to the source
  89 tarball."
  90   (string-append "https://hackage.haskell.org/package/" name
  91                  "/" name "-" version ".tar.gz"))
  92
  93 (define* (hackage-cabal-url name #:optional version)
  94   "Given a Hackage package NAME and VERSION, return a url to the corresponding
  95 .cabal file on Hackage.  If VERSION is #f or missing, the url for the latest
  96 version is returned."
  97   (if version
  98       (string-append "https://hackage.haskell.org/package/"
  99                      name "-" version "/" name ".cabal")
 100       (string-append "https://hackage.haskell.org/package/"
 101                      name "/" name ".cabal")))
 102
 103 (define (hackage-name->package-name name)
 104   "Given the NAME of a Cabal package, return the corresponding Guix name."
 105   (if (string-prefix? package-name-prefix name)
 106       (string-downcase name)
 107       (string-append package-name-prefix (string-downcase name))))
 108
 109 (define guix-package->hackage-name
 110   (let ((uri-rx (make-regexp "https?://hackage.haskell.org/package/([^/]+)/.*"))
 111         (name-rx (make-regexp "(.*)-[0-9\\.]+")))
 112     (lambda (package)
 113       "Given a Guix package name, return the corresponding Hackage name."
 114       (let* ((source-url (and=> (package-source package) origin-uri))
 115              (name (match:substring (regexp-exec uri-rx source-url) 1)))
 116         (match (regexp-exec name-rx name)
 117           (#f name)
 118           (m (match:substring m 1)))))))
 119
 120 (define (read-cabal-and-hash port)
 121   "Read a Cabal file from PORT and return it and its hash in nix-base32
 122 format as two values."
 123   (let-values (((port get-hash) (open-sha256-input-port port)))
 124     (values (read-cabal (canonical-newline-port port))
 125             (bytevector->nix-base32-string (get-hash)))))
 126
 127 (define (hackage-fetch-and-hash name-version)
 128   "Fetch the latest Cabal revision for the package NAME-VERSION, and return
 129 two values: the parsed Cabal file and its hash in nix-base32 format.  If the
 130 version part is omitted from the package name, then fetch the latest
 131 version.  On failure, both return values will be #f."
 132   (guard (c ((and (http-get-error? c)
 133                   (= 404 (http-get-error-code c)))
 134              (values #f #f)))           ;"expected" if package is unknown
 135     (let*-values (((name version) (package-name->name+version name-version))
 136                   ((url)          (hackage-cabal-url name version))
 137                   ((port _)       (http-fetch url))
 138                   ((cabal hash)   (read-cabal-and-hash port)))
 139       (close-port port)
 140       (values cabal hash))))
 141
 142 (define (hackage-fetch name-version)
 143   "Return the Cabal file for the package NAME-VERSION, or #f on failure.  If
 144 the version part is omitted from the package name, then return the latest
 145 version."
 146   (let-values (((cabal hash) (hackage-fetch-and-hash name-version)))
 147     cabal))
 148
 149 (define string->license
 150   ;; List of valid values from
 151   ;; https://www.haskell.org
 152   ;; /cabal/release/cabal-latest/doc/API/Cabal/Distribution-License.html.
 153   (match-lambda
 154    ("GPL-2" 'gpl2)
 155    ("GPL-3" 'gpl3)
 156    ("GPL" "'gpl??")
 157    ("AGPL-3" 'agpl3)
 158    ("AGPL" "'agpl??")
 159    ("LGPL-2.1" 'lgpl2.1)
 160    ("LGPL-3" 'lgpl3)
 161    ("LGPL" "'lgpl??")
 162    ("BSD2" 'bsd-2)
 163    ("BSD3" 'bsd-3)
 164    ("BSD-3-Clause" 'bsd-3)
 165    ("MIT" 'expat)
 166    ("ISC" 'isc)
 167    ("MPL" 'mpl2.0)
 168    ("Apache-2.0" 'asl2.0)
 169    ("PublicDomain" 'public-domain)
 170    ((x) (string->license x))
 171    ((lst ...) `(list ,@(map string->license lst)))
 172    (_ #f)))
 173
 174
 175 (define (cabal-dependencies->names cabal)
 176   "Return the list of dependencies names from the CABAL package object,
 177 not including test suite dependencies or custom-setup dependencies."
 178   (let* ((lib (cabal-package-library cabal))
 179          (lib-deps (if (pair? lib)
 180                        (map cabal-dependency-name
 181                             (append-map cabal-library-dependencies lib))
 182                        '()))
 183          (exe (cabal-package-executables cabal))
 184          (exe-deps (if (pair? exe)
 185                        (map cabal-dependency-name
 186                             (append-map cabal-executable-dependencies exe))
 187                        '())))
 188     (delete-duplicates (append lib-deps exe-deps))))
 189
 190 (define (cabal-test-dependencies->names cabal)
 191   "Return the list of test suite dependencies from the CABAL package
 192 object."
 193   (let* ((ts (cabal-package-test-suites cabal))
 194          (ts-deps (if (pair? ts)
 195                       (map cabal-dependency-name
 196                            (append-map cabal-test-suite-dependencies ts))
 197                       '())))
 198     ts-deps))
 199
 200 (define (cabal-custom-setup-dependencies->names cabal)
 201   "Return the list of custom-setup dependencies from the CABAL package
 202 object."
 203   (let* ((custom-setup-dependencies (or (and=> (cabal-package-custom-setup cabal)
 204                                                cabal-custom-setup-dependencies)
 205                                         '())))
 206     (map cabal-dependency-name custom-setup-dependencies)))
 207
 208 (define (filter-dependencies dependencies own-name)
 209   "Filter the dependencies included with the GHC compiler from DEPENDENCIES, a
 210 list with the names of dependencies.  OWN-NAME is the name of the Cabal
 211 package being processed and is used to filter references to itself."
 212   (filter (lambda (d) (not (member (string-downcase d)
 213                                    (cons own-name ghc-standard-libraries))))
 214           dependencies))
 215
 216 (define* (hackage-module->sexp cabal cabal-hash
 217                                #:key (include-test-dependencies? #t))
 218   "Return the `package' S-expression for a Cabal package.  CABAL is the
 219 representation of a Cabal file as produced by 'read-cabal'.  CABAL-HASH is
 220 the hash of the Cabal file."
 221
 222   (define name
 223     (cabal-package-name cabal))
 224
 225   (define version
 226     (cabal-package-version cabal))
 227
 228   (define revision
 229     (cabal-package-revision cabal))
 230
 231   (define source-url
 232     (hackage-source-url name version))
 233
 234   (define hackage-dependencies
 235     ((compose (cut filter-dependencies <>
 236                    (cabal-package-name cabal))
 237               (cut cabal-dependencies->names <>))
 238      cabal))
 239
 240   (define hackage-native-dependencies
 241     (lset-difference
 242      equal?
 243      ((compose (cut filter-dependencies <>
 244                     (cabal-package-name cabal))
 245                ;; FIXME: Check include-test-dependencies?
 246                (lambda (cabal)
 247                  (append (if include-test-dependencies?
 248                              (cabal-test-dependencies->names cabal)
 249                              '())
 250                          (cabal-custom-setup-dependencies->names cabal))))
 251       cabal)
 252      hackage-dependencies))
 253
 254   (define dependencies
 255     (map (lambda (name)
 256            (list name (list 'unquote (string->symbol name))))
 257          (map hackage-name->package-name
 258               hackage-dependencies)))
 259
 260   (define native-dependencies
 261     (map (lambda (name)
 262            (list name (list 'unquote (string->symbol name))))
 263          (map hackage-name->package-name
 264               hackage-native-dependencies)))
 265
 266   (define (maybe-inputs input-type inputs)
 267     (match inputs
 268       (()
 269        '())
 270       ((inputs ...)
 271        (list (list input-type
 272                    (list 'quasiquote inputs))))))
 273
 274   (define (maybe-arguments)
 275     (match (append (if (not include-test-dependencies?)
 276                        '(#:tests? #f)
 277                        '())
 278                    (if (not (string-null? revision))
 279                        `(#:cabal-revision (,revision ,cabal-hash))
 280                        '()))
 281       (() '())
 282       (args `((arguments (,'quasiquote ,args))))))
 283
 284   (let ((tarball (with-store store
 285                    (download-to-store store source-url))))
 286     (values
 287      `(package
 288         (name ,(hackage-name->package-name name))
 289         (version ,version)
 290         (source (origin
 291                   (method url-fetch)
 292                   (uri (string-append ,@(factorize-uri source-url version)))
 293                   (sha256
 294                    (base32
 295                     ,(if tarball
 296                          (bytevector->nix-base32-string (file-sha256 tarball))
 297                          "failed to download tar archive")))))
 298         (build-system haskell-build-system)
 299         ,@(maybe-inputs 'inputs dependencies)
 300         ,@(maybe-inputs 'native-inputs native-dependencies)
 301         ,@(maybe-arguments)
 302         (home-page ,(cabal-package-home-page cabal))
 303         (synopsis ,(cabal-package-synopsis cabal))
 304         (description ,(cabal-package-description cabal))
 305         (license ,(string->license (cabal-package-license cabal))))
 306      (append hackage-dependencies hackage-native-dependencies))))
 307
 308 (define* (hackage->guix-package package-name #:key
 309                                 (include-test-dependencies? #t)
 310                                 (port #f)
 311                                 (cabal-environment '()))
 312   "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
 313 called with keyword parameter PORT, from PORT.  Return the `package'
 314 S-expression corresponding to that package, or #f on failure.
 315 CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal
 316 conditionals are evaluated.  The accepted keys are: \"os\", \"arch\", \"impl\"
 317 and the name of a flag.  The value associated with a flag has to be either the
 318 symbol 'true' or 'false'.  The value associated with other keys has to conform
 319 to the Cabal file format definition.  The default value associated with the
 320 keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\"
 321 respectively."
 322   (let-values (((cabal-meta cabal-hash)
 323                 (if port
 324                     (read-cabal-and-hash port)
 325                     (hackage-fetch-and-hash package-name))))
 326     (and=> cabal-meta (compose (cut hackage-module->sexp <> cabal-hash
 327                                     #:include-test-dependencies?
 328                                     include-test-dependencies?)
 329                                (cut eval-cabal <> cabal-environment)))))
 330
 331 (define hackage->guix-package/m                   ;memoized variant
 332   (memoize hackage->guix-package))
 333
 334 (define* (hackage-recursive-import package-name . args)
 335   (recursive-import package-name #f
 336                     #:repo->guix-package (lambda (name repo)
 337                                            (apply hackage->guix-package/m
 338                                                   (cons name args)))
 339                     #:guix-name hackage-name->package-name))
 340
 341 (define (hackage-package? package)
 342   "Return #t if PACKAGE is a Haskell package from Hackage."
 343
 344   (define haskell-url?
 345     (let ((hackage-rx (make-regexp "https?://hackage.haskell.org")))
 346       (lambda (url)
 347         (regexp-exec hackage-rx url))))
 348
 349   (let ((source-url (and=> (package-source package) origin-uri))
 350         (fetch-method (and=> (package-source package) origin-method)))
 351     (and (eq? fetch-method url-fetch)
 352          (match source-url
 353            ((? string?)
 354             (haskell-url? source-url))
 355            ((source-url ...)
 356             (any haskell-url? source-url))))))
 357
 358 (define (latest-release package)
 359   "Return an <upstream-source> for the latest release of PACKAGE."
 360   (let* ((hackage-name (guix-package->hackage-name package))
 361          (cabal-meta (hackage-fetch hackage-name)))
 362     (match cabal-meta
 363       (#f
 364        (format (current-error-port)
 365                "warning: failed to parse ~a~%"
 366                (hackage-cabal-url hackage-name))
 367        #f)
 368       ((_ *** ("version" (version)))
 369        (let ((url (hackage-source-url hackage-name version)))
 370          (upstream-source
 371           (package (package-name package))
 372           (version version)
 373           (urls (list url))))))))
 374
 375 (define %hackage-updater
 376   (upstream-updater
 377    (name 'hackage)
 378    (description "Updater for Hackage packages")
 379    (pred hackage-package?)
 380    (latest latest-release)))
 381
 382 ;;; cabal.scm ends here