From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id aMQHF543hWJ/KgAAbAwnHQ (envelope-from ) for ; Wed, 18 May 2022 20:14:54 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id aL4IF543hWLdUwEA9RJhRA (envelope-from ) for ; Wed, 18 May 2022 20:14:54 +0200 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id A682D1A4B4 for ; Wed, 18 May 2022 20:14:53 +0200 (CEST) Received: from localhost ([::1]:38776 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nrOCA-0001Jn-He for larch@yhetil.org; Wed, 18 May 2022 14:14:50 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:45098) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nrOAV-0007pw-Q7 for guix-patches@gnu.org; Wed, 18 May 2022 14:13:07 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:39628) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nrOAU-0005ET-Gm for guix-patches@gnu.org; Wed, 18 May 2022 14:13:06 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nrOAU-0006Ma-CY for guix-patches@gnu.org; Wed, 18 May 2022 14:13:06 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#55030] [PATCH v2 09/34] import: Add Elm importer. Resent-From: Philip McGrath Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 18 May 2022 18:13:06 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 55030 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 55030@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Philip McGrath Received: via spool by 55030-submit@debbugs.gnu.org id=B55030.165289758024337 (code B ref 55030); Wed, 18 May 2022 18:13:06 +0000 Received: (at 55030) by debbugs.gnu.org; 18 May 2022 18:13:00 +0000 Received: from localhost ([127.0.0.1]:33499 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nrOAC-0006Jm-AW for submit@debbugs.gnu.org; Wed, 18 May 2022 14:13:00 -0400 Received: from mail-vk1-f180.google.com ([209.85.221.180]:45036) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nrOAA-0006JL-HK for 55030@debbugs.gnu.org; Wed, 18 May 2022 14:12:47 -0400 Received: by mail-vk1-f180.google.com with SMTP id x11so1077518vkn.11 for <55030@debbugs.gnu.org>; Wed, 18 May 2022 11:12:46 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=philipmcgrath.com; s=google; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=J9+eHOP2o38MJXOUbxokdEbuqAhuiqCTBFxMx51elug=; b=ii6+POYXX+446rjOeKRWP1liJNer3fd/ryrb7DzB61VqNc4ZPwk+OGihVo7KMDhzR7 gK4Ctfunr5t7Rq8I5TQpGbWUa0P7e+Nfko/ctbRUe6BvjeOf/smTOJk4c0YX8jxBjQ8U 4gJM0/H5XEMXEzeHQJX82v9JrSrKAf6y7/R//zh6WOeacg5smkvwT99II3qIXtJh0J9n kIFKeFyccmn/6Z3hIsi9wSWGvreSJ887BnIG21pGa78yN8+aQ7i+agGQx3nlhOUcksG/ 4LB+y2dXl8bH8C1GcrYZOMf1/cRKah1ibMd8RNKbtsZmrkNwcFUQyKopTRXpoIwR/QsR 8ijQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=J9+eHOP2o38MJXOUbxokdEbuqAhuiqCTBFxMx51elug=; b=qXZCbg61/LksVVqefZ9yWWb2xRfUHDZjb4VZMYAF0EdvqaRG/V/H//Gr4vwklW07YT Kb2cTEI8x4N6UY/Zsu4SqSBoYjmVI0+yR4QzVMGBFxwI/DrHTUX1EXcc72vaa6IDyMVO NPHsv4UDZaAJYXv3WD82ncIVTqO8zxCDcOEKqJDzZSampClET9UdhPQzBoXmW4/gkchk usF9R5AHR67d9PPLgADK/70M2xW8ZvTVRYLC3dOc3mahWYOh7PRajywyhvJ5hcC+QHlx W6XElxzu4/+r9uGWKxcCRXPgRkEJZvqNecIH065WKRlk+svJyH//PJEZ2FA7P98Ybovf Eyiw== X-Gm-Message-State: AOAM5315v0/aSf2oay9V00CYB9w3gLk9dBDN9yBKgHBVuptcXQbM5Fa2 UwHsYFiioXxzFgAupjiNqTXyfSuoYvZtn56l X-Google-Smtp-Source: ABdhPJzzUbIbGCsif5LJZHkiaLp9y2qlDRU5uFfWAjpVRHCW8qyrBaO1Nwt+eWuU8Os0dMJWASNbzg== X-Received: by 2002:a1f:ed86:0:b0:356:e57f:38f3 with SMTP id l128-20020a1fed86000000b00356e57f38f3mr522583vkh.40.1652897560554; Wed, 18 May 2022 11:12:40 -0700 (PDT) Received: from localhost (c-73-125-98-51.hsd1.fl.comcast.net. [73.125.98.51]) by smtp.gmail.com with UTF8SMTPSA id l12-20020a056102242c00b0032d275e6917sm251918vsi.23.2022.05.18.11.12.40 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Wed, 18 May 2022 11:12:40 -0700 (PDT) From: Philip McGrath Date: Wed, 18 May 2022 14:10:56 -0400 Message-Id: <04fbe538a0ce1566381ed270987127c461c28b73.1652890702.git.philip@philipmcgrath.com> X-Mailer: git-send-email 2.32.0 In-Reply-To: References: <20220419232736.272970-1-philip@philipmcgrath.com> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN X-Migadu-To: larch@yhetil.org X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1652897693; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=qbG6zO5V/+Tsgqt52j12QpvF1oP8bB7XRzN9EbO68OE=; b=FHV/HlFiuvbY0eNZ2GJVn40a0Km/yqXAOilJGo3mnY8cWdHsoE4UsA9Z7okKS/STEdFJD4 OB1q3dtqVxOwjJzJ1DsBYtdyuplZ32IZw5D6+87ueewFXSl5/yVykMDGYus6gebFtXLUQG JxDnVIbn1Q/sRKdTvxSTLFFWoxQfofnbb+zgo44SQZWyCxFjdGwWiUbsAZJU57MwB1B43g i5yvEloPvtXYLiXWP7gpjnVHuYI5Sd7B0qclO4fPIhyfFf89zwgEElSCMQmeF4mwYTtsOJ PaSZhQGO88PC2jA4/p/wp2DPZNvT60RCCrg+il9w/fZ83W2snDicFCT46COLdQ== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1652897693; a=rsa-sha256; cv=none; b=D682g+HAARf9u27Vp+OcZbTscTGFbx49Mh6P9odT4vMZ9X10Qj48sVgZ92LBKgbUSyTs/V 1F6gIIc+JogDZXXMFh4r6iC0OWp8yGIhN4U7MSCIoyDpqM10CLFvFJTChvsRnF11/v2CBw TAhsgOcpdyNP+UOnghCeYTABogJTzk/7UdgyXEVbIzk5ijIYb3EwWMFEEp7cWDWWowjxb5 RLNQTkmdwPI5onFHTwBa9kYAPoLxHoKSOlDu2E0poEz3kyMU9gxCwy8RfpWQX4V3K0POU3 db6Xc7ghdBRq9rSVZflOWl9YvHQnPZm5RM0N73ug77DkS84FK/2ryLH9aFv9nw== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=philipmcgrath.com header.s=google header.b=ii6+POYX; dmarc=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: 2.96 Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=philipmcgrath.com header.s=google header.b=ii6+POYX; dmarc=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: A682D1A4B4 X-Spam-Score: 2.96 X-Migadu-Scanner: scn0.migadu.com X-TUID: t789FREsc3hG * guix/import/elm.scm, guix/scripts/import/elm.scm: New files. * Makefile.am (MODULES): Add them. * guix/scripts/import.scm (importers): Add "elm". * doc/guix.texi (Invoking guix import): Document Elm importer. * doc/contributing.texi (Elm Packages): Mention it. * tests/elm.scm ("(guix import elm)"): New test group. --- Makefile.am | 2 + doc/contributing.texi | 4 +- doc/guix.texi | 25 +++++ guix/import/elm.scm | 210 ++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 3 +- guix/scripts/import/elm.scm | 107 ++++++++++++++++++ tests/elm.scm | 171 +++++++++++++++++++++++++++++ 7 files changed, 519 insertions(+), 3 deletions(-) create mode 100644 guix/import/elm.scm create mode 100644 guix/scripts/import/elm.scm diff --git a/Makefile.am b/Makefile.am index 9ca92c407c..5a42bb90b2 100644 --- a/Makefile.am +++ b/Makefile.am @@ -259,6 +259,7 @@ MODULES = \ guix/import/cran.scm \ guix/import/crate.scm \ guix/import/egg.scm \ + guix/import/elm.scm \ guix/import/elpa.scm \ guix/import/gem.scm \ guix/import/git.scm \ @@ -310,6 +311,7 @@ MODULES = \ guix/scripts/import/crate.scm \ guix/scripts/import/cran.scm \ guix/scripts/import/egg.scm \ + guix/scripts/import/elm.scm \ guix/scripts/import/elpa.scm \ guix/scripts/import/gem.scm \ guix/scripts/import/gnu.scm \ diff --git a/doc/contributing.texi b/doc/contributing.texi index 555b9bb961..2354874cb0 100644 --- a/doc/contributing.texi +++ b/doc/contributing.texi @@ -919,8 +919,8 @@ Elm Packages In many cases we can reconstruct an Elm package's upstream name heuristically, but, since conversion to a Guix-style name involves a loss of information, this is not always possible. Care should be taken to add the -@code{'upstream-name} property when necessary so that tools -will work correctly. The most notable scenarios +@code{'upstream-name} property when necessary so that @samp{guix import elm} +will work correctly (@pxref{Invoking guix import}). The most notable scenarios when explicitly specifying the upstream name is necessary are: @enumerate diff --git a/doc/guix.texi b/doc/guix.texi index 63fb647045..d7bc7523cd 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -13157,6 +13157,31 @@ Invoking guix import in Guix. @end table +@item elm +@cindex elm +Import metadata from the Elm package repository +@uref{https://package.elm-lang.org, package.elm-lang.org}, as in this example: + +@example +guix import elm elm-explorations/webgl +@end example + +The Elm importer also allows you to specify a version string: + +@example +guix import elm elm-explorations/webgl@@1.1.3 +@end example + +Additional options include: + +@table @code +@item --recursive +@itemx -r +Traverse the dependency graph of the given upstream package recursively +and generate package expressions for all those packages that are not yet +in Guix. +@end table + @item opam @cindex OPAM @cindex OCaml diff --git a/guix/import/elm.scm b/guix/import/elm.scm new file mode 100644 index 0000000000..74902b8617 --- /dev/null +++ b/guix/import/elm.scm @@ -0,0 +1,210 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Philip McGrath +;;; +;;; 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 . + +(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 http-client) + #: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-package-registry + %current-elm-checkout + elm->guix-package)) + +(define %registry-url + ;; It is much nicer to fetch this small (< 40 KB gzipped) + ;; file once than to do many HTTP requests. + "https://package.elm-lang.org/all-packages") + +(define %elm-package-registry + ;; This is a parameter to support both testing and memoization. + ;; In pseudo-code, it has the contract: + ;; (parameter/c (-> json/c) + ;; (promise/c (vhash/c string? (listof string?)))) + ;; To set the parameter, provide a thunk that returns a value suitable + ;; as an argument to 'json->registry-vhash'. Accessing the parameter + ;; returns a promise wrapping the resulting vhash. + (make-parameter + (lambda () + (cond + ((json-fetch %registry-url #:http-fetch http-fetch/cached)) + (else + (raise (formatted-message + (G_ "error downloading Elm package registry from ~a") + %registry-url))))) + (lambda (thunk) + (delay (json->registry-vhash (thunk)))))) + +(define (json->registry-vhash jsobject) + "Parse the '(json)' module's representation of the Elm package registry to a +vhash mapping package names to lists of available versions, sorted from latest +to oldest." + (fold (lambda (entry vh) + (match entry + ((name . vec) + (vhash-cons name + (sort (vector->list vec) version>?) + vh)))) + vlist-null + jsobject)) + +(define (json->direct-dependencies jsobject) + "Parse the '(json)' module's representation of an 'elm.json' file's +'dependencies' or 'test-dependencies' field to a list of strings naming direct +dependencies, handling both the 'package' and 'application' grammars." + (cond + ;; *unspecified* + ((not (pair? jsobject)) + '()) + ;; {"type":"application"} + ((every (match-lambda + (((or "direct" "indirect") (_ . _) ...) + #t) + (_ + #f)) + jsobject) + (map car (or (assoc-ref jsobject "direct") '()))) + ;; {"type":"package"} + (else + (map car jsobject)))) + +;; handles both {"type":"package"} and {"type":"application"} +(define-json-mapping make-project-info project-info? + json->project-info + (dependencies project-info-dependencies + "dependencies" json->direct-dependencies) + (test-dependencies project-info-test-dependencies + "test-dependencies" json->direct-dependencies) + ;; "synopsis" and "license" may be missing for {"type":"application"} + (synopsis project-info-synopsis + "summary" (lambda (x) + (if (string? x) + x + ""))) + (license project-info-license + "license" (lambda (x) + (if (string? x) + (spdx-string->license x) + #f)))) + +(define %current-elm-checkout + ;; This is a parameter for testing purposes. + (make-parameter + (lambda (name version) + (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))) + checkout))) + +(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 checkout + ((%current-elm-checkout) name version)) + (define info + (call-with-input-file (string-append checkout "/elm.json") + json->project-info)) + (define dependencies + (project-info-dependencies info)) + (define test-dependencies + (project-info-test-dependencies info)) + (define guix-name + (elm->package-name name)) + (values + `(package + (name ,guix-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 ,(project-info-synopsis info)) + (description + ;; Try to use the first paragraph of README.md (which Elm requires), + ;; or fall back to synopsis otherwise. + ,(beautify-description + (match (chunk-lines (call-with-input-file + (string-append checkout "/README.md") + read-lines)) + ((_ par . _) + (string-join par " ")) + (_ + (project-info-synopsis info))))) + ,@(let ((inferred-name (infer-elm-package-name guix-name))) + (if (equal? inferred-name name) + '() + `((properties '((upstream-name . ,name)))))) + (license ,(project-info-license info))) + (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 (force (%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)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 40fa6759ae..fa79f3211e 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2021 Simon Tournier ;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2022 Philip McGrath ;;; ;;; This file is part of GNU Guix. ;;; @@ -80,7 +81,7 @@ (define %standard-import-options '()) (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" "gem" "go" "cran" "crate" "texlive" "json" "opam" - "minetest")) + "minetest" "elm")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/elm.scm b/guix/scripts/import/elm.scm new file mode 100644 index 0000000000..68dcbf1070 --- /dev/null +++ b/guix/scripts/import/elm.scm @@ -0,0 +1,107 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Philip McGrath +;;; +;;; 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 . + +(define-module (guix scripts import elm) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import elm) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-elm)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (G_ "Usage: guix import elm PACKAGE-NAME + +Import and convert the Elm package PACKAGE-NAME. Optionally, a version +can be specified after the arobas (@) character.\n")) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -r, --recursive import packages recursively")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import elm"))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive #t result))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-elm . args) + (define (parse-options) + ;; Return the alist of option values. + (parse-command-line args %options (list %default-options) + #:build-options? #f)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((spec) + (with-error-handling + (let ((name version (package-name->name+version spec))) + (if (assoc-ref opts 'recursive) + ;; Recursive import + (map (match-lambda + ((and ('package ('name name) . rest) pkg) + `(define-public ,(string->symbol name) + ,pkg)) + (_ #f)) + (elm-recursive-import name version)) + ;; Single import + (let ((sexp (elm->guix-package name #:version version))) + (unless sexp + (leave (G_ "failed to download meta-data for package '~a'~%") + name)) + sexp))))) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) diff --git a/tests/elm.scm b/tests/elm.scm index 96f958f060..c30623da03 100644 --- a/tests/elm.scm +++ b/tests/elm.scm @@ -18,6 +18,13 @@ (define-module (test-elm) #:use-module (guix build-system elm) + #:use-module (guix import elm) + #:use-module (guix base32) + #:use-module (guix hash) + #:use-module (guix utils) + #:autoload (gcrypt hash) (hash-algorithm sha256) + #:use-module (json) + #:use-module (ice-9 match) #:use-module (srfi srfi-64)) (test-begin "elm") @@ -94,4 +101,168 @@ (define-module (test-elm) (test-not-inferred "gcc-toolchain") (test-not-inferred "font-adobe-source-sans-pro"))) +(define test-package-registry-json + ;; we intentionally list versions in different orders here + "{ + \"elm/core\": [\"1.0.0\", \"1.0.1\", \"1.0.2\", \"1.0.3\", \"1.0.4\"], + \"elm-guix/demo\": [\"2.0.0\", \"3.0.0\", \"1.0.0\"] +}") + +(define test-elm-core-json + "{ + \"type\": \"package\", + \"name\": \"elm/core\", + \"summary\": \"Elm's standard libraries\", + \"license\": \"BSD-3-Clause\", + \"version\": \"1.0.4\", + \"exposed-modules\": { + \"Primitives\": [ + \"Basics\", + \"String\", + \"Char\", + \"Bitwise\", + \"Tuple\" + ], + \"Collections\": [ + \"List\", + \"Dict\", + \"Set\", + \"Array\" + ], + \"Error Handling\": [ + \"Maybe\", + \"Result\" + ], + \"Debug\": [ + \"Debug\" + ], + \"Effects\": [ + \"Platform.Cmd\", + \"Platform.Sub\", + \"Platform\", + \"Process\", + \"Task\" + ] + }, + \"elm-version\": \"0.19.0 <= v < 0.20.0\", + \"dependencies\": {}, + \"test-dependencies\": {} +}") + +(define test-elm-core-readme + "# Core Libraries + +Every Elm project needs this package! + +It provides **basic functionality** like addition and subtraction as well as +**data structures** like lists, dictionaries, and sets.") + +(define test-elm-guix-demo-json + "{ + \"type\": \"package\", + \"name\": \"elm-guix/demo\", + \"summary\": \"A test for `(guix import elm)`\", + \"license\": \"GPL-3.0-or-later\", + \"version\": \"3.0.0\", + \"exposed-modules\": [ + \"Guix.Demo\" + ], + \"elm-version\": \"0.19.0 <= v < 0.20.0\", + \"dependencies\": { + \"elm/core\": \"1.0.0 <= v < 2.0.0\" + }, + \"test-dependencies\": { + \"elm/json\": \"1.0.0 <= v < 2.0.0\" + } +}") + +(define test-elm-guix-demo-readme + ;; intentionally left blank + "") + +(define (directory-sha256 directory) + "Returns the string representing the hash of DIRECTORY as would be used in a +package definition." + (bytevector->nix-base32-string + (file-hash* directory + #:algorithm (hash-algorithm sha256) + #:recursive? #t))) + +(test-group "(guix import elm)" + (call-with-temporary-directory + (lambda (dir) + ;; Initialize our fake git checkouts. + (define elm-core-dir + (string-append dir "/test-elm-core-1.0.4")) + (define elm-guix-demo-dir + (string-append dir "/test-elm-guix-demo-3.0.0")) + (for-each (match-lambda + ((dir json readme) + (mkdir dir) + (with-output-to-file (string-append dir "/elm.json") + (lambda () + (display json))) + (with-output-to-file (string-append dir "/README.md") + (lambda () + (display readme))))) + `((,elm-core-dir ,test-elm-core-json ,test-elm-core-readme) + (,elm-guix-demo-dir + ,test-elm-guix-demo-json + ,test-elm-guix-demo-readme))) + ;; Replace network resources with sample data. + (parameterize ((%elm-package-registry + (lambda () + (json-string->scm test-package-registry-json))) + (%current-elm-checkout + (lambda (name version) + (match (list name version) + (("elm/core" "1.0.4") + elm-core-dir) + (("elm-guix/demo" "3.0.0") + elm-guix-demo-dir))))) + (test-assert "(elm->guix-package \"elm/core\")" + (match (elm->guix-package "elm/core") + (`(package + (name "elm-core") + (version "1.0.4") + (source (elm-package-origin + "elm/core" + version + (base32 ,(? string? hash)))) + (build-system elm-build-system) + (home-page + "https://package.elm-lang.org/packages/elm/core/1.0.4") + (synopsis "Elm's standard libraries") + (description "Every Elm project needs this package!") + (license license:bsd-3)) + (equal? (directory-sha256 elm-core-dir) + hash)) + (x + (raise-exception x)))) + (test-assert "(elm-recursive-import \"elm-guix/demo\")" + (match (elm-recursive-import "elm-guix/demo") + (`((package + (name "elm-guix-demo") + (version "3.0.0") + (source (elm-package-origin + "elm-guix/demo" + version + (base32 ,(? string? hash)))) + (build-system elm-build-system) + (propagated-inputs + ,'`(("elm-core" ,elm-core))) + (inputs + ,'`(("elm-json" ,elm-json))) + (home-page + "https://package.elm-lang.org/packages/elm-guix/demo/3.0.0") + (synopsis "A test for `(guix import elm)`") + (description + "This package provides a test for `(guix import elm)`") + (properties '((upstream-name . "elm-guix/demo"))) + (license license:gpl3+))) + (equal? (directory-sha256 elm-guix-demo-dir) + hash)) + (x + (raise-exception x)))))))) + (test-end "elm") -- 2.32.0