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

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; 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-hackage)
  #:use-module (guix import cabal)
  #:use-module (guix import hackage)
  #:use-module (guix tests)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match))

(define test-cabal-1
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
executable cabal
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3
")

(define test-cabal-2
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
executable cabal {
build-depends:
  HTTP       >= 4000.2.5 && < 4000.3,
  mtl        >= 2.0      && < 3
}
")

;; Check compiler implementation test with and without spaces.
(define test-cabal-3
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if impl(ghc >= 7.2 && < 7.6)
    Build-depends: ghc-a
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
  if impl(ghc == 7.8)
    Build-depends: 
      HTTP       >= 4000.2.5 && < 4000.3,
      mtl        >= 2.0      && < 3
")

;; Check "-any", "-none" when name is different.
(define test-cabal-4
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if impl(ghcjs -any)
    Build-depends: ghc-a
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
  if impl(ghc == 7.8)
    Build-depends: 
      HTTP       >= 4000.2.5 && < 4000.3,
      mtl        >= 2.0      && < 3
")

;; Check "-any", "-none".
(define test-cabal-5
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if impl(ghc == 7.8)
    Build-depends: 
      HTTP       >= 4000.2.5 && < 4000.3,
  if impl(ghc -any)
    Build-depends: mtl        >= 2.0      && < 3
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
")

;; Check "custom-setup".
(define test-cabal-6
  "name: foo
build-type: Custom
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
custom-setup
  setup-depends: base >= 4.7 && < 5,
                 Cabal >= 1.24,
                 haskell-gi == 0.21.*
library
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
  if impl(ghc == 7.8)
    Build-depends: 
      HTTP       >= 4000.2.5 && < 4000.3,
      mtl        >= 2.0      && < 3
")

;; A fragment of a real Cabal file with minor modification to check precedence
;; of 'and' over 'or', missing final newline, spaces between keywords and
;; parentheses and between key and column.
(define test-read-cabal-1
  "name: test-me
library
  -- Choose which library versions to use.
  if flag(base4point8)
    Build-depends: base >= 4.8 && < 5
  else
    if flag(base4)
      Build-depends: base >= 4 && < 4.8
    else
      if flag(base3)
        Build-depends: base >= 3 && < 4
      else
        Build-depends: base < 3
  if flag(base4point8) || flag (base4) && flag(base3)
    Build-depends: random
  Build-depends : containers

  -- Modules that are always built.
  Exposed-Modules:
    Test.QuickCheck.Exception")

(test-begin "hackage")

(define-syntax-rule (define-package-matcher name pattern)
  (define* (name obj)
    (match obj
      (pattern #t)
      (x       (pk 'fail x #f)))))

(define-package-matcher match-ghc-foo
  ('package
    ('name "ghc-foo")
    ('version "1.0.0")
    ('source
     ('origin
       ('method 'url-fetch)
       ('uri ('string-append
              "https://hackage.haskell.org/package/foo/foo-"
              'version
              ".tar.gz"))
       ('sha256
        ('base32
         (? string? hash)))))
    ('build-system 'haskell-build-system)
    ('inputs
     ('quasiquote
      (("ghc-http" ('unquote 'ghc-http)))))
    ('home-page "http://test.org")
    ('synopsis (? string?))
    ('description (? string?))
    ('license 'bsd-3)))

(define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '()))
  (define port (open-input-string test-cabal))
  (matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)))

(test-assert "hackage->guix-package test 1"
  (eval-test-with-cabal test-cabal-1 match-ghc-foo))

(test-assert "hackage->guix-package test 2"
  (eval-test-with-cabal test-cabal-2 match-ghc-foo))

(test-assert "hackage->guix-package test 3"
  (eval-test-with-cabal test-cabal-3 match-ghc-foo
                        #:cabal-environment '(("impl" . "ghc-7.8"))))

(test-assert "hackage->guix-package test 4"
  (eval-test-with-cabal test-cabal-4 match-ghc-foo
                        #:cabal-environment '(("impl" . "ghc-7.8"))))

(test-assert "hackage->guix-package test 5"
  (eval-test-with-cabal test-cabal-5 match-ghc-foo
                        #:cabal-environment '(("impl" . "ghc-7.8"))))

(define-package-matcher match-ghc-foo-6
  ('package
    ('name "ghc-foo")
    ('version "1.0.0")
    ('source
     ('origin
       ('method 'url-fetch)
       ('uri ('string-append
              "https://hackage.haskell.org/package/foo/foo-"
              'version
              ".tar.gz"))
       ('sha256
        ('base32
         (? string? hash)))))
    ('build-system 'haskell-build-system)
    ('inputs
     ('quasiquote
      (("ghc-b" ('unquote 'ghc-b))
       ("ghc-http" ('unquote 'ghc-http)))))
    ('native-inputs
     ('quasiquote
      (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi)))))
    ('home-page "http://test.org")
    ('synopsis (? string?))
    ('description (? string?))
    ('license 'bsd-3)))

(test-assert "hackage->guix-package test 6"
  (eval-test-with-cabal test-cabal-6 match-ghc-foo-6))

;; Check multi-line layouted description
(define test-cabal-multiline-layout
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description:   first line
               second line
license: BSD3
executable cabal
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3
")

(test-assert "hackage->guix-package test multiline desc (layout)"
  (eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo))

;; Check multi-line braced description
(define test-cabal-multiline-braced
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: {
first line
second line
}
license: BSD3
executable cabal
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3
")

(test-assert "hackage->guix-package test multiline desc (braced)"
  (eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo))

(test-assert "read-cabal test 1"
  (match (call-with-input-string test-read-cabal-1 read-cabal)
    ((("name" ("test-me"))
      ('section 'library
                (('if ('flag "base4point8")
                      (("build-depends" ("base >= 4.8 && < 5")))
                      (('if ('flag "base4")
                            (("build-depends" ("base >= 4 && < 4.8")))
                            (('if ('flag "base3")
                                  (("build-depends" ("base >= 3 && < 4")))
                                  (("build-depends" ("base < 3"))))))))
                 ('if ('or ('flag "base4point8")
                           ('and ('flag "base4") ('flag "base3")))
                      (("build-depends" ("random")))
                      ())
                 ("build-depends" ("containers"))
                 ("exposed-modules" ("Test.QuickCheck.Exception")))))
     #t)
    (x (pk 'fail x #f))))

(test-end "hackage")
Commit	Line	Data
b29455cf FB	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
	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-hackage)
a4154748	20	#:use-module (guix import cabal)
b29455cf FB	21	#:use-module (guix import hackage)
	22	#:use-module (guix tests)
	23	#:use-module (srfi srfi-64)
	24	#:use-module (ice-9 match))
	25
	26	(define test-cabal-1
	27	"name: foo
	28	version: 1.0.0
	29	homepage: http://test.org
	30	synopsis: synopsis
	31	description: description
	32	license: BSD3
	33	executable cabal
	34	build-depends:
	35	HTTP >= 4000.2.5 && < 4000.3,
	36	mtl >= 2.0 && < 3
	37	")
	38
b29455cf	39	(define test-cabal-2
b29455cf FB	40	"name: foo
	41	version: 1.0.0
	42	homepage: http://test.org
	43	synopsis: synopsis
	44	description: description
	45	license: BSD3
a4154748 FB	46	executable cabal {
	47	build-depends:
	48	HTTP >= 4000.2.5 && < 4000.3,
	49	mtl >= 2.0 && < 3
	50	}
b29455cf FB	51	")
b29455cf FB	52
d3c827e4 FB	53	;; Check compiler implementation test with and without spaces.
	54	(define test-cabal-3
	55	"name: foo
	56	version: 1.0.0
	57	homepage: http://test.org
	58	synopsis: synopsis
	59	description: description
	60	license: BSD3
	61	library
	62	if impl(ghc >= 7.2 && < 7.6)
	63	Build-depends: ghc-a
	64	if impl(ghc>=7.2&&<7.6)
	65	Build-depends: ghc-b
	66	if impl(ghc == 7.8)
	67	Build-depends:
	68	HTTP >= 4000.2.5 && < 4000.3,
	69	mtl >= 2.0 && < 3
	70	")
	71
e39a44f3 DM	72	;; Check "-any", "-none" when name is different.
	73	(define test-cabal-4
	74	"name: foo
	75	version: 1.0.0
	76	homepage: http://test.org
	77	synopsis: synopsis
	78	description: description
	79	license: BSD3
	80	library
	81	if impl(ghcjs -any)
	82	Build-depends: ghc-a
	83	if impl(ghc>=7.2&&<7.6)
	84	Build-depends: ghc-b
	85	if impl(ghc == 7.8)
	86	Build-depends:
	87	HTTP >= 4000.2.5 && < 4000.3,
	88	mtl >= 2.0 && < 3
	89	")
	90
	91	;; Check "-any", "-none".
	92	(define test-cabal-5
	93	"name: foo
	94	version: 1.0.0
	95	homepage: http://test.org
	96	synopsis: synopsis
	97	description: description
	98	license: BSD3
	99	library
	100	if impl(ghc == 7.8)
	101	Build-depends:
	102	HTTP >= 4000.2.5 && < 4000.3,
	103	if impl(ghc -any)
	104	Build-depends: mtl >= 2.0 && < 3
	105	if impl(ghc>=7.2&&<7.6)
	106	Build-depends: ghc-b
	107	")
	108
	109	;; Check "custom-setup".
	110	(define test-cabal-6
	111	"name: foo
	112	build-type: Custom
	113	version: 1.0.0
	114	homepage: http://test.org
	115	synopsis: synopsis
	116	description: description
	117	license: BSD3
	118	custom-setup
	119	setup-depends: base >= 4.7 && < 5,
	120	Cabal >= 1.24,
	121	haskell-gi == 0.21.*
	122	library
	123	if impl(ghc>=7.2&&<7.6)
	124	Build-depends: ghc-b
	125	if impl(ghc == 7.8)
	126	Build-depends:
	127	HTTP >= 4000.2.5 && < 4000.3,
	128	mtl >= 2.0 && < 3
	129	")
	130
a4154748	131	;; A fragment of a real Cabal file with minor modification to check precedence
d3c827e4 FB	132	;; of 'and' over 'or', missing final newline, spaces between keywords and
d3c827e4 FB	133	;; parentheses and between key and column.
a4154748 FB	134	(define test-read-cabal-1
	135	"name: test-me
	136	library
	137	-- Choose which library versions to use.
	138	if flag(base4point8)
	139	Build-depends: base >= 4.8 && < 5
	140	else
	141	if flag(base4)
	142	Build-depends: base >= 4 && < 4.8
	143	else
	144	if flag(base3)
	145	Build-depends: base >= 3 && < 4
	146	else
	147	Build-depends: base < 3
d3c827e4	148	if flag(base4point8) \|\| flag (base4) && flag(base3)
a4154748	149	Build-depends: random
d3c827e4	150	Build-depends : containers
a4154748 FB	151
	152	-- Modules that are always built.
	153	Exposed-Modules:
d3c827e4	154	Test.QuickCheck.Exception")
b29455cf FB	155
	156	(test-begin "hackage")
	157
55c98f32 RV	158	(define-syntax-rule (define-package-matcher name pattern)
	159	(define* (name obj)
	160	(match obj
	161	(pattern #t)
	162	(x (pk 'fail x #f)))))
	163
	164	(define-package-matcher match-ghc-foo
	165	('package
	166	('name "ghc-foo")
	167	('version "1.0.0")
	168	('source
	169	('origin
	170	('method 'url-fetch)
	171	('uri ('string-append
	172	"https://hackage.haskell.org/package/foo/foo-"
	173	'version
	174	".tar.gz"))
	175	('sha256
	176	('base32
	177	(? string? hash)))))
	178	('build-system 'haskell-build-system)
	179	('inputs
	180	('quasiquote
ea35f5c5	181	(("ghc-http" ('unquote 'ghc-http)))))
55c98f32 RV	182	('home-page "http://test.org")
	183	('synopsis (? string?))
	184	('description (? string?))
	185	('license 'bsd-3)))
	186
	187	(define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '()))
4110cde0 RV	188	(define port (open-input-string test-cabal))
4110cde0 RV	189	(matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)))
b29455cf FB	190
b29455cf FB	191	(test-assert "hackage->guix-package test 1"
55c98f32	192	(eval-test-with-cabal test-cabal-1 match-ghc-foo))
b29455cf FB	193
b29455cf FB	194	(test-assert "hackage->guix-package test 2"
55c98f32	195	(eval-test-with-cabal test-cabal-2 match-ghc-foo))
b29455cf	196
d3c827e4	197	(test-assert "hackage->guix-package test 3"
55c98f32	198	(eval-test-with-cabal test-cabal-3 match-ghc-foo
d3c827e4 FB	199	#:cabal-environment '(("impl" . "ghc-7.8"))))
d3c827e4 FB	200
e39a44f3	201	(test-assert "hackage->guix-package test 4"
55c98f32	202	(eval-test-with-cabal test-cabal-4 match-ghc-foo
e39a44f3 DM	203	#:cabal-environment '(("impl" . "ghc-7.8"))))
	204
	205	(test-assert "hackage->guix-package test 5"
55c98f32	206	(eval-test-with-cabal test-cabal-5 match-ghc-foo
e39a44f3 DM	207	#:cabal-environment '(("impl" . "ghc-7.8"))))
e39a44f3 DM	208
55c98f32 RV	209	(define-package-matcher match-ghc-foo-6
	210	('package
	211	('name "ghc-foo")
	212	('version "1.0.0")
	213	('source
	214	('origin
	215	('method 'url-fetch)
	216	('uri ('string-append
	217	"https://hackage.haskell.org/package/foo/foo-"
	218	'version
	219	".tar.gz"))
	220	('sha256
	221	('base32
	222	(? string? hash)))))
	223	('build-system 'haskell-build-system)
	224	('inputs
	225	('quasiquote
	226	(("ghc-b" ('unquote 'ghc-b))
ea35f5c5	227	("ghc-http" ('unquote 'ghc-http)))))
55c98f32 RV	228	('native-inputs
	229	('quasiquote
	230	(("ghc-haskell-gi" ('unquote 'ghc-haskell-gi)))))
	231	('home-page "http://test.org")
	232	('synopsis (? string?))
	233	('description (? string?))
	234	('license 'bsd-3)))
	235
e39a44f3	236	(test-assert "hackage->guix-package test 6"
55c98f32	237	(eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
e39a44f3	238
64d31813	239	;; Check multi-line layouted description
959c9d15	240	(define test-cabal-multiline-layout
64d31813 RV	241	"name: foo
	242	version: 1.0.0
	243	homepage: http://test.org
	244	synopsis: synopsis
	245	description: first line
	246	second line
	247	license: BSD3
	248	executable cabal
	249	build-depends:
	250	HTTP >= 4000.2.5 && < 4000.3,
	251	mtl >= 2.0 && < 3
	252	")
	253
959c9d15 RV	254	(test-assert "hackage->guix-package test multiline desc (layout)"
959c9d15 RV	255	(eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo))
64d31813	256
959c9d15 RV	257	;; Check multi-line braced description
	258	(define test-cabal-multiline-braced
	259	"name: foo
	260	version: 1.0.0
	261	homepage: http://test.org
	262	synopsis: synopsis
	263	description: {
	264	first line
	265	second line
	266	}
	267	license: BSD3
	268	executable cabal
	269	build-depends:
	270	HTTP >= 4000.2.5 && < 4000.3,
	271	mtl >= 2.0 && < 3
	272	")
	273
	274	(test-assert "hackage->guix-package test multiline desc (braced)"
	275	(eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo))
64d31813	276
a4154748 FB	277	(test-assert "read-cabal test 1"
	278	(match (call-with-input-string test-read-cabal-1 read-cabal)
	279	((("name" ("test-me"))
	280	('section 'library
0be46592 RV	281	(('if ('flag "base4point8")
	282	(("build-depends" ("base >= 4.8 && < 5")))
	283	(('if ('flag "base4")
	284	(("build-depends" ("base >= 4 && < 4.8")))
	285	(('if ('flag "base3")
	286	(("build-depends" ("base >= 3 && < 4")))
	287	(("build-depends" ("base < 3"))))))))
	288	('if ('or ('flag "base4point8")
	289	('and ('flag "base4") ('flag "base3")))
	290	(("build-depends" ("random")))
	291	())
	292	("build-depends" ("containers"))
	293	("exposed-modules" ("Test.QuickCheck.Exception")))))
b29455cf	294	#t)
a4154748	295	(x (pk 'fail x #f))))
b29455cf FB	296
b29455cf FB	297	(test-end "hackage")