* 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.
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
		
	
			
		
			
				
	
	
		
			268 lines
		
	
	
	
		
			10 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
			
		
		
	
	
			268 lines
		
	
	
	
		
			10 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
| ;;; 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 (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")
 | |
| 
 | |
| (test-group "elm->package-name and infer-elm-package-name"
 | |
|   (test-group "round trip"
 | |
|     ;; Cases when our heuristics can find the upstream name.
 | |
|     (define-syntax-rule (test-round-trip elm guix)
 | |
|       (test-group elm
 | |
|         (test-equal "elm->package-name" guix
 | |
|                     (elm->package-name elm))
 | |
|         (test-equal "infer-elm-package-name" elm
 | |
|                     (infer-elm-package-name guix))))
 | |
|     (test-round-trip "elm/core" "elm-core")
 | |
|     (test-round-trip "elm/html" "elm-html")
 | |
|     (test-round-trip "elm-explorations/markdown" "elm-explorations-markdown")
 | |
|     (test-round-trip "elm-explorations/test" "elm-explorations-test")
 | |
|     (test-round-trip "elm-explorations/foo-bar" "elm-explorations-foo-bar")
 | |
|     (test-round-trip "elm/explorations" "elm-explorations")
 | |
|     (test-round-trip "terezka/intervals" "elm-terezka-intervals")
 | |
|     (test-round-trip "justinmimbs/time-extra" "elm-justinmimbs-time-extra")
 | |
|     (test-round-trip "danhandrea/elm-date-format"
 | |
|                      "elm-danhandrea-elm-date-format"))
 | |
|   (test-group "upstream-name needed"
 | |
|     ;; Upstream names that our heuristic can't infer.  We still check that the
 | |
|     ;; round-trip behavior of 'infer-elm-package-name' works as promised for
 | |
|     ;; the hypothetical Elm name it doesn't infer.
 | |
|     (define-syntax-rule (test-upstream-needed elm guix inferred)
 | |
|       (test-group elm
 | |
|         (test-equal "elm->package-name" guix
 | |
|                     (elm->package-name elm))
 | |
|         (test-group "infer-elm-package-name"
 | |
|           (test-equal "infers other name" inferred
 | |
|                       (infer-elm-package-name guix))
 | |
|           (test-equal "infered name round-trips" guix
 | |
|                       (elm->package-name inferred)))))
 | |
|     (test-upstream-needed "elm/virtual-dom"
 | |
|                           "elm-virtual-dom"
 | |
|                           "virtual/dom")
 | |
|     (test-upstream-needed "elm/project-metadata-utils"
 | |
|                           "elm-project-metadata-utils"
 | |
|                           "project/metadata-utils")
 | |
|     (test-upstream-needed "explorations/foo"
 | |
|                           "elm-explorations-foo"
 | |
|                           "elm-explorations/foo")
 | |
|     (test-upstream-needed "explorations/foo-bar"
 | |
|                           "elm-explorations-foo-bar"
 | |
|                           "elm-explorations/foo-bar")
 | |
|     (test-upstream-needed "explorations-central/foo"
 | |
|                           "elm-explorations-central-foo"
 | |
|                           "elm-explorations/central-foo")
 | |
|     (test-upstream-needed "explorations-central/foo-bar"
 | |
|                           "elm-explorations-central-foo-bar"
 | |
|                           "elm-explorations/central-foo-bar")
 | |
|     (test-upstream-needed "elm-xyz/foo"
 | |
|                           "elm-xyz-foo"
 | |
|                           "xyz/foo")
 | |
|     (test-upstream-needed "elm-xyz/foo-bar"
 | |
|                           "elm-xyz-foo-bar"
 | |
|                           "xyz/foo-bar")
 | |
|     (test-upstream-needed "elm-explorations-xyz/foo"
 | |
|                           "elm-explorations-xyz-foo"
 | |
|                           "elm-explorations/xyz-foo")
 | |
|     (test-upstream-needed "elm-explorations-xyz/foo-bar"
 | |
|                           "elm-explorations-xyz-foo-bar"
 | |
|                           "elm-explorations/xyz-foo-bar"))
 | |
|   (test-group "no inferred Elm name"
 | |
|     ;; Cases that 'infer-elm-package-name' should not attempt to handle,
 | |
|     ;; because 'elm->package-name' would never produce such names.
 | |
|     (define-syntax-rule (test-not-inferred guix)
 | |
|       (test-assert guix (not (infer-elm-package-name guix))))
 | |
|     (test-not-inferred "elm")
 | |
|     (test-not-inferred "guile")
 | |
|     (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")
 |