guix/import/stackage.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
   3 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (guix import stackage)
  21   #:use-module (ice-9 match)
  22   #:use-module (ice-9 regex)
  23   #:use-module (srfi srfi-1)
  24   #:use-module (srfi srfi-26)
  25   #:use-module (srfi srfi-34)
  26   #:use-module (srfi srfi-35)
  27   #:use-module (guix import json)
  28   #:use-module (guix import hackage)
  29   #:use-module (guix import utils)
  30   #:use-module (guix memoization)
  31   #:use-module (guix packages)
  32   #:use-module (guix upstream)
  33   #:export (stackage->guix-package
  34             stackage-recursive-import
  35             %stackage-updater))
  36
  37 \f
  38 ;;;
  39 ;;; Stackage info fetcher and access functions
  40 ;;;
  41
  42 (define %stackage-url "http://www.stackage.org")
  43
  44 (define (lts-info-ghc-version lts-info)
  45   "Retruns the version of the GHC compiler contained in LTS-INFO."
  46   (and=> (assoc-ref lts-info "snapshot")
  47          (cut assoc-ref <> "ghc")))
  48
  49 (define (lts-info-packages lts-info)
  50   "Retruns the alist of packages contained in LTS-INFO."
  51   (or (assoc-ref lts-info "packages") '()))
  52
  53 (define (leave-with-message fmt . args)
  54   (raise (condition (&message (message (apply format #f fmt args))))))
  55
  56 (define stackage-lts-info-fetch
  57   ;; "Retrieve the information about the LTS Stackage release VERSION."
  58   (memoize
  59    (lambda* (#:optional (version ""))
  60      (let* ((url (if (string=? "" version)
  61                      (string-append %stackage-url "/lts")
  62                      (string-append %stackage-url "/lts-" version)))
  63             (lts-info (json-fetch url)))
  64        (if lts-info
  65            (reverse lts-info)
  66            (leave-with-message "LTS release version not found: ~a" version))))))
  67
  68 (define (stackage-package-name pkg-info)
  69   (assoc-ref pkg-info "name"))
  70
  71 (define (stackage-package-version pkg-info)
  72   (assoc-ref pkg-info "version"))
  73
  74 (define (lts-package-version pkgs-info name)
  75   "Return the version of the package with upstream NAME included in PKGS-INFO."
  76   (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name))
  77                    (vector->list pkgs-info))))
  78     (stackage-package-version pkg)))
  79
  80 \f
  81 ;;;
  82 ;;; Importer entry point
  83 ;;;
  84
  85 (define (hackage-name-version name version)
  86   (and version (string-append  name "@" version)))
  87
  88 (define stackage->guix-package
  89   (memoize
  90    (lambda* (package-name ; upstream name
  91              #:key
  92              (include-test-dependencies? #t)
  93              (lts-version "")
  94              (packages-info
  95               (lts-info-packages
  96                (stackage-lts-info-fetch lts-version))))
  97      "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org.  The retrieved
  98 version corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION
  99 release at stackage.org.  Return the `package' S-expression corresponding to
 100 that package, or #f on failure.  PACKAGES-INFO is the alist with the packages
 101 included in the Stackage LTS release."
 102      (let* ((version (lts-package-version packages-info package-name))
 103             (name-version (hackage-name-version package-name version)))
 104        (if name-version
 105            (hackage->guix-package name-version
 106                                   #:include-test-dependencies?
 107                                   include-test-dependencies?)
 108            (leave-with-message "~a: Stackage package not found" package-name))))))
 109
 110 (define (stackage-recursive-import package-name . args)
 111   (recursive-import package-name #f
 112                     #:repo->guix-package (lambda (name repo)
 113                                            (apply stackage->guix-package (cons name args)))
 114                     #:guix-name hackage-name->package-name))
 115
 116 \f
 117 ;;;
 118 ;;; Updater
 119 ;;;
 120
 121 (define latest-lts-release
 122   (let ((pkgs-info (mlambda () (lts-info-packages (stackage-lts-info-fetch)))))
 123     (lambda* (package)
 124       "Return an <upstream-source> for the latest Stackage LTS release of
 125 PACKAGE or #f if the package is not included in the Stackage LTS release."
 126       (let* ((hackage-name (guix-package->hackage-name package))
 127              (version (lts-package-version (pkgs-info) hackage-name))
 128              (name-version (hackage-name-version hackage-name version)))
 129         (match (and=> name-version hackage-fetch)
 130           (#f (format (current-error-port)
 131                       "warning: failed to parse ~a~%"
 132                       (hackage-cabal-url hackage-name))
 133               #f)
 134           (_ (let ((url (hackage-source-url hackage-name version)))
 135                (upstream-source
 136                 (package (package-name package))
 137                 (version version)
 138                 (urls (list url))))))))))
 139
 140 (define %stackage-updater
 141   (upstream-updater
 142    (name 'stackage)
 143    (description "Updater for Stackage LTS packages")
 144    (pred hackage-package?)
 145    (latest latest-lts-release)))
 146
 147 ;;; stackage.scm ends here