tests/hackage.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
   3 ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
   4 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
   5 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (test-hackage)
  23   #:use-module (guix import cabal)
  24   #:use-module (guix import hackage)
  25   #:use-module (guix tests)
  26   #:use-module (srfi srfi-64)
  27   #:use-module (ice-9 match))
  28
  29 (define test-cabal-1
  30   "name: foo
  31 version: 1.0.0
  32 homepage: http://test.org
  33 synopsis: synopsis
  34 description: description
  35 license: BSD3
  36 executable cabal
  37   build-depends:
  38     HTTP       >= 4000.2.5 && < 4000.3,
  39     mtl        >= 2.0      && < 3
  40 ")
  41
  42 (define test-cabal-2
  43   "name: foo
  44 version: 1.0.0
  45 homepage: http://test.org
  46 synopsis: synopsis
  47 description: description
  48 license: BSD3
  49 executable cabal {
  50 build-depends:
  51   HTTP       >= 4000.2.5 && < 4000.3,
  52   mtl        >= 2.0      && < 3
  53 }
  54 ")
  55
  56 ;; Check compiler implementation test with and without spaces.
  57 (define test-cabal-3
  58   "name: foo
  59 version: 1.0.0
  60 homepage: http://test.org
  61 synopsis: synopsis
  62 description: description
  63 license: BSD3
  64 library
  65   if impl(ghc >= 7.2 && < 7.6)
  66     Build-depends: ghc-a
  67   if impl(ghc>=7.2&&<7.6)
  68     Build-depends: ghc-b
  69   if impl(ghc == 7.8)
  70     Build-depends:
  71       HTTP       >= 4000.2.5 && < 4000.3,
  72       mtl        >= 2.0      && < 3
  73 ")
  74
  75 ;; Check "-any", "-none" when name is different.
  76 (define test-cabal-4
  77   "name: foo
  78 version: 1.0.0
  79 homepage: http://test.org
  80 synopsis: synopsis
  81 description: description
  82 license: BSD3
  83 library
  84   if impl(ghcjs -any)
  85     Build-depends: ghc-a
  86   if impl(ghc>=7.2&&<7.6)
  87     Build-depends: ghc-b
  88   if impl(ghc == 7.8)
  89     Build-depends:
  90       HTTP       >= 4000.2.5 && < 4000.3,
  91       mtl        >= 2.0      && < 3
  92 ")
  93
  94 ;; Check "-any", "-none".
  95 (define test-cabal-5
  96   "name: foo
  97 version: 1.0.0
  98 homepage: http://test.org
  99 synopsis: synopsis
 100 description: description
 101 license: BSD3
 102 library
 103   if impl(ghc == 7.8)
 104     Build-depends:
 105       HTTP       >= 4000.2.5 && < 4000.3,
 106   if impl(ghc -any)
 107     Build-depends: mtl        >= 2.0      && < 3
 108   if impl(ghc>=7.2&&<7.6)
 109     Build-depends: ghc-b
 110 ")
 111
 112 ;; Check "custom-setup".
 113 (define test-cabal-6
 114   "name: foo
 115 build-type: Custom
 116 version: 1.0.0
 117 homepage: http://test.org
 118 synopsis: synopsis
 119 description: description
 120 license: BSD3
 121 custom-setup
 122   setup-depends: base >= 4.7 && < 5,
 123                  Cabal >= 1.24,
 124                  haskell-gi == 0.21.*
 125 library
 126   if impl(ghc>=7.2&&<7.6)
 127     Build-depends: ghc-b
 128   if impl(ghc == 7.8)
 129     Build-depends:
 130       HTTP       >= 4000.2.5 && < 4000.3,
 131       mtl        >= 2.0      && < 3
 132 ")
 133
 134 ;; A fragment of a real Cabal file with minor modification to check precedence
 135 ;; of 'and' over 'or', missing final newline, spaces between keywords and
 136 ;; parentheses and between key and column.
 137 (define test-read-cabal-1
 138   "name: test-me
 139 library
 140   -- Choose which library versions to use.
 141   if flag(base4point8)
 142     Build-depends: base >= 4.8 && < 5
 143   else
 144     if flag(base4)
 145       Build-depends: base >= 4 && < 4.8
 146     else
 147       if flag(base3)
 148         Build-depends: base >= 3 && < 4
 149       else
 150         Build-depends: base < 3
 151   if flag(base4point8) || flag (base4) && flag(base3)
 152     Build-depends: random
 153   Build-depends : containers
 154
 155   -- Modules that are always built.
 156   Exposed-Modules:
 157     Test.QuickCheck.Exception")
 158
 159 (define test-read-cabal-2
 160   "name: test-me
 161 common defaults
 162     if os(foobar) { cc-options: -DBARBAZ }
 163 ") ; Intentional newline.
 164
 165 ;; Test opening bracket on new line.
 166 (define test-read-cabal-brackets-newline
 167   "name: test-me
 168 common defaults
 169     build-depends:
 170     {  foobar
 171     ,  barbaz
 172     }
 173 ")
 174
 175 ;; Test library with (since Cabal 2.0) and without names.
 176 (define test-read-cabal-library-name
 177   "name: test-me
 178 library foobar
 179     build-depends: foo, bar
 180 library
 181     build-depends: bar, baz
 182 ")
 183
 184 (test-begin "hackage")
 185
 186 (define-syntax-rule (define-package-matcher name pattern)
 187   (define* (name obj)
 188     (match obj
 189       (pattern #t)
 190       (x       (pk 'fail x #f)))))
 191
 192 (define-package-matcher match-ghc-foo
 193   ('package
 194     ('name "ghc-foo")
 195     ('version "1.0.0")
 196     ('source
 197      ('origin
 198        ('method 'url-fetch)
 199        ('uri ('hackage-uri "foo" 'version))
 200        ('sha256
 201         ('base32
 202          (? string? hash)))))
 203     ('build-system 'haskell-build-system)
 204     ('inputs ('list 'ghc-http))
 205     ('home-page "http://test.org")
 206     ('synopsis (? string?))
 207     ('description (? string?))
 208     ('license 'license:bsd-3)))
 209
 210 (define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '()))
 211   (define port (open-input-string test-cabal))
 212   (matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)))
 213
 214 (test-assert "hackage->guix-package test 1"
 215   (eval-test-with-cabal test-cabal-1 match-ghc-foo))
 216
 217 (test-assert "hackage->guix-package test 2"
 218   (eval-test-with-cabal test-cabal-2 match-ghc-foo))
 219
 220 (test-assert "hackage->guix-package test 3"
 221   (eval-test-with-cabal test-cabal-3 match-ghc-foo
 222                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 223
 224 (test-assert "hackage->guix-package test 4"
 225   (eval-test-with-cabal test-cabal-4 match-ghc-foo
 226                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 227
 228 (test-assert "hackage->guix-package test 5"
 229   (eval-test-with-cabal test-cabal-5 match-ghc-foo
 230                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 231
 232 (define-package-matcher match-ghc-foo-6
 233   ('package
 234     ('name "ghc-foo")
 235     ('version "1.0.0")
 236     ('source
 237      ('origin
 238        ('method 'url-fetch)
 239        ('uri ('hackage-uri "foo" 'version))
 240        ('sha256
 241         ('base32
 242          (? string? hash)))))
 243     ('build-system 'haskell-build-system)
 244     ('inputs ('list 'ghc-b 'ghc-http))
 245     ('native-inputs ('list 'ghc-haskell-gi))
 246     ('home-page "http://test.org")
 247     ('synopsis (? string?))
 248     ('description (? string?))
 249     ('license 'license:bsd-3)))
 250
 251 (test-assert "hackage->guix-package test 6"
 252   (eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
 253
 254 ;; Check multi-line layouted description.
 255 (define test-cabal-multiline-layout
 256   "name: foo
 257 version: 1.0.0
 258 homepage: http://test.org
 259 synopsis: synopsis
 260 description:   first line
 261                second line
 262 license: BSD3
 263 executable cabal
 264   build-depends:
 265     HTTP       >= 4000.2.5 && < 4000.3,
 266     mtl        >= 2.0      && < 3
 267 ")
 268
 269 (test-assert "hackage->guix-package test multiline desc (layout)"
 270   (eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo))
 271
 272 ;; Check multi-line braced description.
 273 (define test-cabal-multiline-braced
 274   "name: foo
 275 version: 1.0.0
 276 homepage: http://test.org
 277 synopsis: synopsis
 278 description: {
 279 first line
 280 second line
 281 }
 282 license: BSD3
 283 executable cabal
 284   build-depends:
 285     HTTP       >= 4000.2.5 && < 4000.3,
 286     mtl        >= 2.0      && < 3
 287 ")
 288
 289 (test-assert "hackage->guix-package test multiline desc (braced)"
 290   (eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo))
 291
 292 ;; Check mixed layout. Compare e.g. warp.
 293 (define test-cabal-mixed-layout
 294   "name: foo
 295 version: 1.0.0
 296 homepage: http://test.org
 297 synopsis: synopsis
 298 description: description
 299 license: BSD3
 300 executable cabal
 301     build-depends:
 302       HTTP       >= 4000.2.5 && < 4000.3,
 303       mtl        >= 2.0      && < 3
 304   ghc-options: -Wall
 305 ")
 306
 307 ;; Fails: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35743
 308 (test-expect-fail 1)
 309 (test-assert "hackage->guix-package test mixed layout"
 310   (eval-test-with-cabal test-cabal-mixed-layout match-ghc-foo))
 311
 312 ;; Check flag executable. Compare e.g. darcs.
 313 (define test-cabal-flag-executable
 314   "name: foo
 315 version: 1.0.0
 316 homepage: http://test.org
 317 synopsis: synopsis
 318 description: description
 319 license: BSD3
 320 flag executable
 321   description: Build executable
 322   default:     True
 323 executable cabal
 324   if !flag(executable)
 325     buildable: False
 326   else
 327     buildable: True
 328
 329   build-depends:
 330     HTTP       >= 4000.2.5 && < 4000.3,
 331     mtl        >= 2.0      && < 3
 332 ")
 333
 334 (test-assert "hackage->guix-package test flag executable"
 335   (eval-test-with-cabal test-cabal-flag-executable match-ghc-foo))
 336
 337 ;; There is no mandatory space between property name and value.
 338 (define test-cabal-property-no-space
 339   "name:foo
 340 version:1.0.0
 341 homepage:http://test.org
 342 synopsis:synopsis
 343 description:description
 344 license:BSD3
 345 common bench-defaults
 346   ghc-options:-Wall
 347 executable cabal
 348   build-depends:
 349     HTTP       >= 4000.2.5 && < 4000.3,
 350     mtl        >= 2.0      && < 3
 351 ")
 352
 353 (test-assert "hackage->guix-package test properties without space"
 354   (eval-test-with-cabal test-cabal-property-no-space match-ghc-foo))
 355
 356 ;; There may be no final newline terminating a property.
 357 (define test-cabal-no-final-newline
 358 "name: foo
 359 version: 1.0.0
 360 homepage: http://test.org
 361 synopsis: synopsis
 362 description: description
 363 license: BSD3
 364 executable cabal
 365   build-depends: HTTP       >= 4000.2.5 && < 4000.3, mtl        >= 2.0      && < 3")
 366
 367 (test-expect-fail 1)
 368 (test-assert "hackage->guix-package test without final newline"
 369   (eval-test-with-cabal test-cabal-no-final-newline match-ghc-foo))
 370
 371 ;; Make sure internal libraries will not be part of the dependencies,
 372 ;; ignore case.
 373 (define test-cabal-internal-library-ignored
 374   "name: foo
 375 version: 1.0.0
 376 homepage: http://test.org
 377 synopsis: synopsis
 378 description: description
 379 license: BSD3
 380 executable cabal
 381   build-depends:
 382     HTTP       >= 4000.2.5 && < 4000.3,
 383     internAl
 384 library internaL
 385   build-depends: mtl        >= 2.0      && < 3
 386 ")
 387
 388 (test-assert "hackage->guix-package test internal libraries are ignored"
 389   (eval-test-with-cabal test-cabal-internal-library-ignored match-ghc-foo))
 390
 391 ;; Check if-elif-else statements
 392 (define test-cabal-if
 393   "name: foo
 394 version: 1.0.0
 395 homepage: http://test.org
 396 synopsis: synopsis
 397 description: description
 398 license: BSD3
 399 library
 400   if os(first)
 401     Build-depends: ghc-c
 402 ")
 403
 404 (define test-cabal-else
 405   "name: foo
 406 version: 1.0.0
 407 homepage: http://test.org
 408 synopsis: synopsis
 409 description: description
 410 license: BSD3
 411 library
 412   if os(first)
 413     Build-depends: ghc-a
 414   else
 415     Build-depends: ghc-c
 416 ")
 417
 418 (define test-cabal-elif
 419   "name: foo
 420 version: 1.0.0
 421 homepage: http://test.org
 422 synopsis: synopsis
 423 description: description
 424 license: BSD3
 425 library
 426   if os(first)
 427     Build-depends: ghc-a
 428   elif os(second)
 429     Build-depends: ghc-b
 430   elif os(guix)
 431     Build-depends: ghc-c
 432   elif os(third)
 433     Build-depends: ghc-d
 434   else
 435     Build-depends: ghc-e
 436 ")
 437
 438 ;; Try the same with different bracket styles
 439 (define test-cabal-elif-brackets
 440   "name: foo
 441 version: 1.0.0
 442 homepage: http://test.org
 443 synopsis: synopsis
 444 description: description
 445 license: BSD3
 446 library
 447   if os(first) {
 448     Build-depends: ghc-a
 449   }
 450   elif os(second)
 451     Build-depends: ghc-b
 452   elif os(guix) { Build-depends: ghc-c }
 453   elif os(third) {
 454     Build-depends: ghc-d }
 455   elif os(fourth)
 456   {
 457     Build-depends: ghc-d
 458   } else
 459     Build-depends: ghc-e
 460 ")
 461
 462 (define-package-matcher match-ghc-elif
 463   ('package
 464     ('name "ghc-foo")
 465     ('version "1.0.0")
 466     ('source
 467      ('origin
 468        ('method 'url-fetch)
 469        ('uri ('hackage-uri "foo" 'version))
 470        ('sha256
 471         ('base32
 472          (? string? hash)))))
 473     ('build-system 'haskell-build-system)
 474     ('inputs ('list 'ghc-c))
 475     ('home-page "http://test.org")
 476     ('synopsis (? string?))
 477     ('description (? string?))
 478     ('license 'license:bsd-3)))
 479
 480 (test-assert "hackage->guix-package test lonely if statement"
 481   (eval-test-with-cabal test-cabal-else match-ghc-elif
 482                         #:cabal-environment '(("os" . "guix"))))
 483
 484 (test-assert "hackage->guix-package test else statement"
 485   (eval-test-with-cabal test-cabal-else match-ghc-elif
 486                         #:cabal-environment '(("os" . "guix"))))
 487
 488 (test-assert "hackage->guix-package test elif statement"
 489   (eval-test-with-cabal test-cabal-elif match-ghc-elif
 490                         #:cabal-environment '(("os" . "guix"))))
 491
 492 (test-assert "hackage->guix-package test elif statement with brackets"
 493   (eval-test-with-cabal test-cabal-elif-brackets match-ghc-elif
 494                         #:cabal-environment '(("os" . "guix"))))
 495
 496 ;; Check Hackage Cabal revisions.
 497 (define test-cabal-revision
 498   "name: foo
 499 version: 1.0.0
 500 x-revision: 2
 501 homepage: http://test.org
 502 synopsis: synopsis
 503 description: description
 504 license: BSD3
 505 executable cabal
 506   build-depends:
 507     HTTP       >= 4000.2.5 && < 4000.3,
 508     mtl        >= 2.0      && < 3
 509 ")
 510
 511 (define-package-matcher match-ghc-foo-revision
 512   ('package
 513     ('name "ghc-foo")
 514     ('version "1.0.0")
 515     ('source
 516      ('origin
 517        ('method 'url-fetch)
 518        ('uri ('hackage-uri "foo" 'version))
 519        ('sha256
 520         ('base32
 521          (? string? hash)))))
 522     ('build-system 'haskell-build-system)
 523     ('inputs ('list 'ghc-http))
 524     ('arguments
 525      ('quasiquote
 526       ('#:cabal-revision
 527        ("2" "0xxd88fb659f0krljidbvvmkh9ppjnx83j0nqzx8whcg4n5qbyng"))))
 528     ('home-page "http://test.org")
 529     ('synopsis (? string?))
 530     ('description (? string?))
 531     ('license 'license:bsd-3)))
 532
 533 (test-assert "hackage->guix-package test cabal revision"
 534   (eval-test-with-cabal test-cabal-revision match-ghc-foo-revision))
 535
 536 (test-assert "read-cabal test 1"
 537   (match (call-with-input-string test-read-cabal-1 read-cabal)
 538     ((("name" ("test-me"))
 539       ('section 'library #f
 540                 (('if ('flag "base4point8")
 541                       (("build-depends" ("base >= 4.8 && < 5")))
 542                       (('if ('flag "base4")
 543                             (("build-depends" ("base >= 4 && < 4.8")))
 544                             (('if ('flag "base3")
 545                                   (("build-depends" ("base >= 3 && < 4")))
 546                                   (("build-depends" ("base < 3"))))))))
 547                  ('if ('or ('flag "base4point8")
 548                            ('and ('flag "base4") ('flag "base3")))
 549                       (("build-depends" ("random")))
 550                       ())
 551                  ("build-depends" ("containers"))
 552                  ("exposed-modules" ("Test.QuickCheck.Exception")))))
 553      #t)
 554     (x (pk 'fail x #f))))
 555
 556 (test-assert "read-cabal test: if brackets on the same line"
 557   (match (call-with-input-string test-read-cabal-2 read-cabal)
 558     ((("name" ("test-me"))
 559         ('section 'common "defaults"
 560           (('if ('os "foobar")
 561                (("cc-options" ("-DBARBAZ ")))
 562                ()))))
 563      #t)
 564     (x (pk 'fail x #f))))
 565
 566 (test-expect-fail 1)
 567 (test-assert "read-cabal test: property brackets on new line"
 568   (match (call-with-input-string test-read-cabal-brackets-newline read-cabal)
 569     ((("name" ("test-me"))
 570         ('section 'common "defaults"
 571           (("build-depends" ("foobar ,  barbaz")))))
 572      #t)
 573     (x (pk 'fail x #f))))
 574
 575 (test-assert "read-cabal test: library name"
 576   (match (call-with-input-string test-read-cabal-library-name read-cabal)
 577     ((("name" ("test-me"))
 578         ('section 'library "foobar"
 579           (("build-depends" ("foo, bar"))))
 580         ('section 'library #f
 581           (("build-depends" ("bar, baz")))))
 582      #t)
 583     (x (pk 'fail x #f))))
 584
 585 (define test-cabal-import
 586   "name: foo
 587 version: 1.0.0
 588 homepage: http://test.org
 589 synopsis: synopsis
 590 description: description
 591 license: BSD3
 592 common commons
 593   build-depends:
 594     HTTP       >= 4000.2.5 && < 4000.3,
 595     mtl        >= 2.0      && < 3
 596
 597 executable cabal
 598   import: commons
 599 ")
 600
 601 (define-package-matcher match-ghc-foo-import
 602   ('package
 603     ('name "ghc-foo")
 604     ('version "1.0.0")
 605     ('source
 606      ('origin
 607        ('method 'url-fetch)
 608        ('uri ('hackage-uri "foo" 'version))
 609        ('sha256
 610         ('base32
 611          (? string? hash)))))
 612     ('build-system 'haskell-build-system)
 613     ('inputs ('list 'ghc-http))
 614     ('home-page "http://test.org")
 615     ('synopsis (? string?))
 616     ('description (? string?))
 617     ('license 'license:bsd-3)))
 618
 619 (test-assert "hackage->guix-package test cabal import"
 620   (eval-test-with-cabal test-cabal-import match-ghc-foo-import))
 621
 622 (test-end "hackage")