Commit | Line | Data |
---|---|---|
bc5844d1 FB |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch> | |
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 stackage) | |
20 | #:use-module (ice-9 match) | |
21 | #:use-module (ice-9 regex) | |
22 | #:use-module (srfi srfi-1) | |
23 | #:use-module (srfi srfi-26) | |
57075ade FB |
24 | #:use-module (srfi srfi-34) |
25 | #:use-module (srfi srfi-35) | |
bc5844d1 FB |
26 | #:use-module (guix import json) |
27 | #:use-module (guix import hackage) | |
28 | #:use-module (guix memoization) | |
29 | #:use-module (guix packages) | |
30 | #:use-module (guix upstream) | |
bc5844d1 FB |
31 | #:export (stackage->guix-package |
32 | %stackage-updater)) | |
33 | ||
34 | \f | |
35 | ;;; | |
36 | ;;; Stackage info fetcher and access functions | |
37 | ;;; | |
38 | ||
39 | (define %stackage-url "http://www.stackage.org") | |
40 | ||
41 | (define (lts-info-ghc-version lts-info) | |
42 | "Retruns the version of the GHC compiler contained in LTS-INFO." | |
43 | (match lts-info | |
44 | ((("snapshot" ("ghc" . version) _ _) _) version) | |
45 | (_ #f))) | |
46 | ||
47 | (define (lts-info-packages lts-info) | |
48 | "Retruns the alist of packages contained in LTS-INFO." | |
49 | (match lts-info | |
50 | ((_ ("packages" pkg ...)) pkg) | |
51 | (_ '()))) | |
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))) | |
3edf0d53 | 63 | (lts-info (json-fetch-alist 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)) | |
77 | 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 package-name ; upstream name | |
89 | #:key | |
90 | (include-test-dependencies? #t) | |
91 | (lts-version "") | |
92 | (packages-info | |
93 | (lts-info-packages | |
94 | (stackage-lts-info-fetch lts-version)))) | |
95 | "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org. The retrieved | |
96 | vesion corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION | |
97 | release at stackage.org. Return the `package' S-expression corresponding to | |
98 | that package, or #f on failure. PACKAGES-INFO is the alist with the packages | |
99 | included in the Stackage LTS release." | |
100 | (let* ((version (lts-package-version packages-info package-name)) | |
101 | (name-version (hackage-name-version package-name version))) | |
102 | (if name-version | |
103 | (hackage->guix-package name-version | |
104 | #:include-test-dependencies? | |
105 | include-test-dependencies?) | |
57075ade | 106 | (leave-with-message "~a: Stackage package not found" package-name)))) |
bc5844d1 FB |
107 | |
108 | \f | |
109 | ;;; | |
110 | ;;; Updater | |
111 | ;;; | |
112 | ||
113 | (define latest-lts-release | |
114 | (let ((pkgs-info (mlambda () (lts-info-packages (stackage-lts-info-fetch))))) | |
115 | (lambda* (package) | |
116 | "Return an <upstream-source> for the latest Stackage LTS release of | |
117 | PACKAGE or #f it the package is not inlucded in the Stackage LTS release." | |
118 | (let* ((hackage-name (guix-package->hackage-name package)) | |
119 | (version (lts-package-version (pkgs-info) hackage-name)) | |
120 | (name-version (hackage-name-version hackage-name version))) | |
121 | (match (and=> name-version hackage-fetch) | |
122 | (#f (format (current-error-port) | |
123 | "warning: failed to parse ~a~%" | |
124 | (hackage-cabal-url hackage-name)) | |
125 | #f) | |
126 | (_ (let ((url (hackage-source-url hackage-name version))) | |
127 | (upstream-source | |
128 | (package (package-name package)) | |
129 | (version version) | |
130 | (urls (list url)))))))))) | |
131 | ||
132 | (define %stackage-updater | |
133 | (upstream-updater | |
134 | (name 'stackage) | |
135 | (description "Updater for Stackage LTS packages") | |
136 | (pred hackage-package?) | |
137 | (latest latest-lts-release))) | |
138 | ||
139 | ;;; stackage.scm ends here |