[jackhill/guix/guix.git] / tests / elm.scm

;;; 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")
Commit	Line	Data
aefcfdd0 PM	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)
903c8258 PM	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)
aefcfdd0 PM	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
903c8258 PM	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
aefcfdd0	268	(test-end "elm")