| 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com> |
| 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 (test-elm) |
| 20 | #:use-module (guix build-system elm) |
| 21 | #:use-module (guix import elm) |
| 22 | #:use-module (guix base32) |
| 23 | #:use-module (guix hash) |
| 24 | #:use-module (guix utils) |
| 25 | #:autoload (gcrypt hash) (hash-algorithm sha256) |
| 26 | #:use-module (json) |
| 27 | #:use-module (ice-9 match) |
| 28 | #:use-module (srfi srfi-64)) |
| 29 | |
| 30 | (test-begin "elm") |
| 31 | |
| 32 | (test-group "elm->package-name and infer-elm-package-name" |
| 33 | (test-group "round trip" |
| 34 | ;; Cases when our heuristics can find the upstream name. |
| 35 | (define-syntax-rule (test-round-trip elm guix) |
| 36 | (test-group elm |
| 37 | (test-equal "elm->package-name" guix |
| 38 | (elm->package-name elm)) |
| 39 | (test-equal "infer-elm-package-name" elm |
| 40 | (infer-elm-package-name guix)))) |
| 41 | (test-round-trip "elm/core" "elm-core") |
| 42 | (test-round-trip "elm/html" "elm-html") |
| 43 | (test-round-trip "elm-explorations/markdown" "elm-explorations-markdown") |
| 44 | (test-round-trip "elm-explorations/test" "elm-explorations-test") |
| 45 | (test-round-trip "elm-explorations/foo-bar" "elm-explorations-foo-bar") |
| 46 | (test-round-trip "elm/explorations" "elm-explorations") |
| 47 | (test-round-trip "terezka/intervals" "elm-terezka-intervals") |
| 48 | (test-round-trip "justinmimbs/time-extra" "elm-justinmimbs-time-extra") |
| 49 | (test-round-trip "danhandrea/elm-date-format" |
| 50 | "elm-danhandrea-elm-date-format")) |
| 51 | (test-group "upstream-name needed" |
| 52 | ;; Upstream names that our heuristic can't infer. We still check that the |
| 53 | ;; round-trip behavior of 'infer-elm-package-name' works as promised for |
| 54 | ;; the hypothetical Elm name it doesn't infer. |
| 55 | (define-syntax-rule (test-upstream-needed elm guix inferred) |
| 56 | (test-group elm |
| 57 | (test-equal "elm->package-name" guix |
| 58 | (elm->package-name elm)) |
| 59 | (test-group "infer-elm-package-name" |
| 60 | (test-equal "infers other name" inferred |
| 61 | (infer-elm-package-name guix)) |
| 62 | (test-equal "infered name round-trips" guix |
| 63 | (elm->package-name inferred))))) |
| 64 | (test-upstream-needed "elm/virtual-dom" |
| 65 | "elm-virtual-dom" |
| 66 | "virtual/dom") |
| 67 | (test-upstream-needed "elm/project-metadata-utils" |
| 68 | "elm-project-metadata-utils" |
| 69 | "project/metadata-utils") |
| 70 | (test-upstream-needed "explorations/foo" |
| 71 | "elm-explorations-foo" |
| 72 | "elm-explorations/foo") |
| 73 | (test-upstream-needed "explorations/foo-bar" |
| 74 | "elm-explorations-foo-bar" |
| 75 | "elm-explorations/foo-bar") |
| 76 | (test-upstream-needed "explorations-central/foo" |
| 77 | "elm-explorations-central-foo" |
| 78 | "elm-explorations/central-foo") |
| 79 | (test-upstream-needed "explorations-central/foo-bar" |
| 80 | "elm-explorations-central-foo-bar" |
| 81 | "elm-explorations/central-foo-bar") |
| 82 | (test-upstream-needed "elm-xyz/foo" |
| 83 | "elm-xyz-foo" |
| 84 | "xyz/foo") |
| 85 | (test-upstream-needed "elm-xyz/foo-bar" |
| 86 | "elm-xyz-foo-bar" |
| 87 | "xyz/foo-bar") |
| 88 | (test-upstream-needed "elm-explorations-xyz/foo" |
| 89 | "elm-explorations-xyz-foo" |
| 90 | "elm-explorations/xyz-foo") |
| 91 | (test-upstream-needed "elm-explorations-xyz/foo-bar" |
| 92 | "elm-explorations-xyz-foo-bar" |
| 93 | "elm-explorations/xyz-foo-bar")) |
| 94 | (test-group "no inferred Elm name" |
| 95 | ;; Cases that 'infer-elm-package-name' should not attempt to handle, |
| 96 | ;; because 'elm->package-name' would never produce such names. |
| 97 | (define-syntax-rule (test-not-inferred guix) |
| 98 | (test-assert guix (not (infer-elm-package-name guix)))) |
| 99 | (test-not-inferred "elm") |
| 100 | (test-not-inferred "guile") |
| 101 | (test-not-inferred "gcc-toolchain") |
| 102 | (test-not-inferred "font-adobe-source-sans-pro"))) |
| 103 | |
| 104 | (define test-package-registry-json |
| 105 | ;; we intentionally list versions in different orders here |
| 106 | "{ |
| 107 | \"elm/core\": [\"1.0.0\", \"1.0.1\", \"1.0.2\", \"1.0.3\", \"1.0.4\"], |
| 108 | \"elm-guix/demo\": [\"2.0.0\", \"3.0.0\", \"1.0.0\"] |
| 109 | }") |
| 110 | |
| 111 | (define test-elm-core-json |
| 112 | "{ |
| 113 | \"type\": \"package\", |
| 114 | \"name\": \"elm/core\", |
| 115 | \"summary\": \"Elm's standard libraries\", |
| 116 | \"license\": \"BSD-3-Clause\", |
| 117 | \"version\": \"1.0.4\", |
| 118 | \"exposed-modules\": { |
| 119 | \"Primitives\": [ |
| 120 | \"Basics\", |
| 121 | \"String\", |
| 122 | \"Char\", |
| 123 | \"Bitwise\", |
| 124 | \"Tuple\" |
| 125 | ], |
| 126 | \"Collections\": [ |
| 127 | \"List\", |
| 128 | \"Dict\", |
| 129 | \"Set\", |
| 130 | \"Array\" |
| 131 | ], |
| 132 | \"Error Handling\": [ |
| 133 | \"Maybe\", |
| 134 | \"Result\" |
| 135 | ], |
| 136 | \"Debug\": [ |
| 137 | \"Debug\" |
| 138 | ], |
| 139 | \"Effects\": [ |
| 140 | \"Platform.Cmd\", |
| 141 | \"Platform.Sub\", |
| 142 | \"Platform\", |
| 143 | \"Process\", |
| 144 | \"Task\" |
| 145 | ] |
| 146 | }, |
| 147 | \"elm-version\": \"0.19.0 <= v < 0.20.0\", |
| 148 | \"dependencies\": {}, |
| 149 | \"test-dependencies\": {} |
| 150 | }") |
| 151 | |
| 152 | (define test-elm-core-readme |
| 153 | "# Core Libraries |
| 154 | |
| 155 | Every Elm project needs this package! |
| 156 | |
| 157 | It provides **basic functionality** like addition and subtraction as well as |
| 158 | **data structures** like lists, dictionaries, and sets.") |
| 159 | |
| 160 | (define test-elm-guix-demo-json |
| 161 | "{ |
| 162 | \"type\": \"package\", |
| 163 | \"name\": \"elm-guix/demo\", |
| 164 | \"summary\": \"A test for `(guix import elm)`\", |
| 165 | \"license\": \"GPL-3.0-or-later\", |
| 166 | \"version\": \"3.0.0\", |
| 167 | \"exposed-modules\": [ |
| 168 | \"Guix.Demo\" |
| 169 | ], |
| 170 | \"elm-version\": \"0.19.0 <= v < 0.20.0\", |
| 171 | \"dependencies\": { |
| 172 | \"elm/core\": \"1.0.0 <= v < 2.0.0\" |
| 173 | }, |
| 174 | \"test-dependencies\": { |
| 175 | \"elm/json\": \"1.0.0 <= v < 2.0.0\" |
| 176 | } |
| 177 | }") |
| 178 | |
| 179 | (define test-elm-guix-demo-readme |
| 180 | ;; intentionally left blank |
| 181 | "") |
| 182 | |
| 183 | (define (directory-sha256 directory) |
| 184 | "Returns the string representing the hash of DIRECTORY as would be used in a |
| 185 | package definition." |
| 186 | (bytevector->nix-base32-string |
| 187 | (file-hash* directory |
| 188 | #:algorithm (hash-algorithm sha256) |
| 189 | #:recursive? #t))) |
| 190 | |
| 191 | (test-group "(guix import elm)" |
| 192 | (call-with-temporary-directory |
| 193 | (lambda (dir) |
| 194 | ;; Initialize our fake git checkouts. |
| 195 | (define elm-core-dir |
| 196 | (string-append dir "/test-elm-core-1.0.4")) |
| 197 | (define elm-guix-demo-dir |
| 198 | (string-append dir "/test-elm-guix-demo-3.0.0")) |
| 199 | (for-each (match-lambda |
| 200 | ((dir json readme) |
| 201 | (mkdir dir) |
| 202 | (with-output-to-file (string-append dir "/elm.json") |
| 203 | (lambda () |
| 204 | (display json))) |
| 205 | (with-output-to-file (string-append dir "/README.md") |
| 206 | (lambda () |
| 207 | (display readme))))) |
| 208 | `((,elm-core-dir ,test-elm-core-json ,test-elm-core-readme) |
| 209 | (,elm-guix-demo-dir |
| 210 | ,test-elm-guix-demo-json |
| 211 | ,test-elm-guix-demo-readme))) |
| 212 | ;; Replace network resources with sample data. |
| 213 | (parameterize ((%elm-package-registry |
| 214 | (lambda () |
| 215 | (json-string->scm test-package-registry-json))) |
| 216 | (%current-elm-checkout |
| 217 | (lambda (name version) |
| 218 | (match (list name version) |
| 219 | (("elm/core" "1.0.4") |
| 220 | elm-core-dir) |
| 221 | (("elm-guix/demo" "3.0.0") |
| 222 | elm-guix-demo-dir))))) |
| 223 | (test-assert "(elm->guix-package \"elm/core\")" |
| 224 | (match (elm->guix-package "elm/core") |
| 225 | (`(package |
| 226 | (name "elm-core") |
| 227 | (version "1.0.4") |
| 228 | (source (elm-package-origin |
| 229 | "elm/core" |
| 230 | version |
| 231 | (base32 ,(? string? hash)))) |
| 232 | (build-system elm-build-system) |
| 233 | (home-page |
| 234 | "https://package.elm-lang.org/packages/elm/core/1.0.4") |
| 235 | (synopsis "Elm's standard libraries") |
| 236 | (description "Every Elm project needs this package!") |
| 237 | (license license:bsd-3)) |
| 238 | (equal? (directory-sha256 elm-core-dir) |
| 239 | hash)) |
| 240 | (x |
| 241 | (raise-exception x)))) |
| 242 | (test-assert "(elm-recursive-import \"elm-guix/demo\")" |
| 243 | (match (elm-recursive-import "elm-guix/demo") |
| 244 | (`((package |
| 245 | (name "elm-guix-demo") |
| 246 | (version "3.0.0") |
| 247 | (source (elm-package-origin |
| 248 | "elm-guix/demo" |
| 249 | version |
| 250 | (base32 ,(? string? hash)))) |
| 251 | (build-system elm-build-system) |
| 252 | (propagated-inputs |
| 253 | ,'`(("elm-core" ,elm-core))) |
| 254 | (inputs |
| 255 | ,'`(("elm-json" ,elm-json))) |
| 256 | (home-page |
| 257 | "https://package.elm-lang.org/packages/elm-guix/demo/3.0.0") |
| 258 | (synopsis "A test for `(guix import elm)`") |
| 259 | (description |
| 260 | "This package provides a test for `(guix import elm)`") |
| 261 | (properties '((upstream-name . "elm-guix/demo"))) |
| 262 | (license license:gpl3+))) |
| 263 | (equal? (directory-sha256 elm-guix-demo-dir) |
| 264 | hash)) |
| 265 | (x |
| 266 | (raise-exception x)))))))) |
| 267 | |
| 268 | (test-end "elm") |