Commit | Line | Data |
---|---|---|
bc5844d1 FB |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch> | |
a3ece51a | 3 | ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> |
bc5844d1 FB |
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) | |
57075ade FB |
25 | #:use-module (srfi srfi-34) |
26 | #:use-module (srfi srfi-35) | |
bc5844d1 FB |
27 | #:use-module (guix import json) |
28 | #:use-module (guix import hackage) | |
a3ece51a | 29 | #:use-module (guix import utils) |
bc5844d1 FB |
30 | #:use-module (guix memoization) |
31 | #:use-module (guix packages) | |
32 | #:use-module (guix upstream) | |
bc5844d1 | 33 | #:export (stackage->guix-package |
a3ece51a | 34 | stackage-recursive-import |
bc5844d1 FB |
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." | |
127586ad TS |
46 | (and=> (assoc-ref lts-info "snapshot") |
47 | (cut assoc-ref <> "ghc"))) | |
bc5844d1 FB |
48 | |
49 | (define (lts-info-packages lts-info) | |
127586ad TS |
50 | "Retruns the alist of packages contained in LTS-INFO." |
51 | (or (assoc-ref lts-info "packages") '())) | |
bc5844d1 | 52 | |
57075ade FB |
53 | (define (leave-with-message fmt . args) |
54 | (raise (condition (&message (message (apply format #f fmt args)))))) | |
55 | ||
bc5844d1 FB |
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))) | |
81c3dc32 | 63 | (lts-info (json-fetch url))) |
bc5844d1 FB |
64 | (if lts-info |
65 | (reverse lts-info) | |
57075ade | 66 | (leave-with-message "LTS release version not found: ~a" version)))))) |
bc5844d1 FB |
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)) | |
81c3dc32 | 77 | (vector->list pkgs-info)))) |
bc5844d1 FB |
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 | ||
a3ece51a RW |
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 | |
fa4867cc | 98 | version corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION |
bc5844d1 FB |
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." | |
a3ece51a RW |
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)) | |
bc5844d1 FB |
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 | |
35b00d4c | 125 | PACKAGE or #f if the package is not included in the Stackage LTS release." |
bc5844d1 FB |
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 |