1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import elm)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (guix utils)
#:use-module (guix base32)
#:use-module (guix hash)
#:use-module (guix memoization)
#:use-module (guix diagnostics)
#:use-module (guix i18n)
#:use-module ((guix ui) #:select (display-hint))
#:use-module ((guix build utils)
#:select ((package-name->name+version
. hyphen-package-name->name+version)
find-files
invoke))
#:use-module (guix import utils)
#:use-module (guix git)
#:use-module (guix import json)
#:autoload (gcrypt hash) (hash-algorithm sha256)
#:use-module (json)
#:use-module (guix packages)
#:use-module (guix upstream)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system elm)
#:export (elm-recursive-import
elm->guix-package))
(define elm-package-registry
;; It is much nicer to fetch this small (< 40 KB gzipped)
;; file once than to do many HTTP requests.
(mlambda ()
"Fetch the Elm package registry, represented as a vhash mapping package
names to lists of available versions, sorted from latest to oldest."
(let ((url "https://package.elm-lang.org/all-packages"))
(cond
((json-fetch url)
=> (lambda (alist)
(fold (lambda (entry vh)
(match entry
((name . vec)
(vhash-cons name
(sort (vector->list vec) version>?)
vh))))
vlist-null
alist)))
(else
(raise (formatted-message
(G_ "error downloading Elm package registry from ~a")
url)))))))
(define (make-elm-package-sexp name version)
"Return two values: the `package' s-expression for the Elm package with the
given NAME and VERSION, and a list of Elm packages it depends on."
(define-values (checkout _commit _relation)
;; Elm requires that packages use this very specific format
(update-cached-checkout (string-append "https://github.com/" name)
#:ref `(tag . ,version)))
(define info
(call-with-input-file (string-append checkout "/elm.json")
json->scm))
(define (get-deps key)
(cond
((assoc-ref info key)
=> (cut map car <>))
(else
'())))
(define dependencies
(get-deps "dependencies"))
(define test-dependencies
(get-deps "test-dependencies"))
(values
`(package
(name ,(elm->package-name name))
(version ,version)
(source (elm-package-origin
,name
version ;; no ,
(base32
,(bytevector->nix-base32-string
(file-hash* checkout
#:algorithm (hash-algorithm sha256)
#:recursive? #t)))))
(build-system elm-build-system)
,@(maybe-propagated-inputs (map elm->package-name dependencies))
,@(maybe-inputs (map elm->package-name test-dependencies))
(home-page ,(string-append "https://package.elm-lang.org/packages/"
name "/" version))
(synopsis ,(assoc-ref info "summary"))
(description
;; Try to use the first paragraph of README.md (which Elm requires),
;; or fall back to summary otherwise.
,(beautify-description
(match (chunk-lines (call-with-input-file
(string-append checkout "/README.md")
read-lines))
((_ par . _)
(string-join par " "))
(_
(assoc-ref info "summary")))))
(license ,(spdx-string->license (assoc-ref info "license")))
;; so we know where the "/" goes
(properties '((upstream-name . ,name))))
(append dependencies test-dependencies)))
(define elm->guix-package
(memoize
(lambda* (package-name #:key repo version)
"Fetch the metadata for PACKAGE-NAME, an Elm package registered at
package.elm.org, and return two values: the `package' s-expression
corresponding to that package (or #f on failure) and a list of Elm
dependencies.."
(cond
((vhash-assoc package-name (elm-package-registry))
=> (match-lambda
((_found latest . _versions)
(make-elm-package-sexp package-name (or version latest)))))
(else
(values #f '()))))))
(define* (elm-recursive-import package-name #:optional version)
(recursive-import package-name
#:version version
#:repo->guix-package elm->guix-package
#:guix-name elm->package-name))
|