;;; 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 (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 (list elm-core)) (inputs (list 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")