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 (test-begin "hackage")
 160
 161 (define-syntax-rule (define-package-matcher name pattern)
 162   (define* (name obj)
 163     (match obj
 164       (pattern #t)
 165       (x       (pk 'fail x #f)))))
 166
 167 (define-package-matcher match-ghc-foo
 168   ('package
 169     ('name "ghc-foo")
 170     ('version "1.0.0")
 171     ('source
 172      ('origin
 173        ('method 'url-fetch)
 174        ('uri ('string-append
 175               "https://hackage.haskell.org/package/foo/foo-"
 176               'version
 177               ".tar.gz"))
 178        ('sha256
 179         ('base32
 180          (? string? hash)))))
 181     ('build-system 'haskell-build-system)
 182     ('inputs ('list 'ghc-http))
 183     ('home-page "http://test.org")
 184     ('synopsis (? string?))
 185     ('description (? string?))
 186     ('license 'license:bsd-3)))
 187
 188 (define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '()))
 189   (define port (open-input-string test-cabal))
 190   (matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)))
 191
 192 (test-assert "hackage->guix-package test 1"
 193   (eval-test-with-cabal test-cabal-1 match-ghc-foo))
 194
 195 (test-assert "hackage->guix-package test 2"
 196   (eval-test-with-cabal test-cabal-2 match-ghc-foo))
 197
 198 (test-assert "hackage->guix-package test 3"
 199   (eval-test-with-cabal test-cabal-3 match-ghc-foo
 200                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 201
 202 (test-assert "hackage->guix-package test 4"
 203   (eval-test-with-cabal test-cabal-4 match-ghc-foo
 204                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 205
 206 (test-assert "hackage->guix-package test 5"
 207   (eval-test-with-cabal test-cabal-5 match-ghc-foo
 208                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 209
 210 (define-package-matcher match-ghc-foo-6
 211   ('package
 212     ('name "ghc-foo")
 213     ('version "1.0.0")
 214     ('source
 215      ('origin
 216        ('method 'url-fetch)
 217        ('uri ('string-append
 218               "https://hackage.haskell.org/package/foo/foo-"
 219               'version
 220               ".tar.gz"))
 221        ('sha256
 222         ('base32
 223          (? string? hash)))))
 224     ('build-system 'haskell-build-system)
 225     ('inputs ('list 'ghc-b 'ghc-http))
 226     ('native-inputs ('list 'ghc-haskell-gi))
 227     ('home-page "http://test.org")
 228     ('synopsis (? string?))
 229     ('description (? string?))
 230     ('license 'license:bsd-3)))
 231
 232 (test-assert "hackage->guix-package test 6"
 233   (eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
 234
 235 ;; Check multi-line layouted description.
 236 (define test-cabal-multiline-layout
 237   "name: foo
 238 version: 1.0.0
 239 homepage: http://test.org
 240 synopsis: synopsis
 241 description:   first line
 242                second line
 243 license: BSD3
 244 executable cabal
 245   build-depends:
 246     HTTP       >= 4000.2.5 && < 4000.3,
 247     mtl        >= 2.0      && < 3
 248 ")
 249
 250 (test-assert "hackage->guix-package test multiline desc (layout)"
 251   (eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo))
 252
 253 ;; Check multi-line braced description.
 254 (define test-cabal-multiline-braced
 255   "name: foo
 256 version: 1.0.0
 257 homepage: http://test.org
 258 synopsis: synopsis
 259 description: {
 260 first line
 261 second line
 262 }
 263 license: BSD3
 264 executable cabal
 265   build-depends:
 266     HTTP       >= 4000.2.5 && < 4000.3,
 267     mtl        >= 2.0      && < 3
 268 ")
 269
 270 (test-assert "hackage->guix-package test multiline desc (braced)"
 271   (eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo))
 272
 273 ;; Check mixed layout. Compare e.g. warp.
 274 (define test-cabal-mixed-layout
 275   "name: foo
 276 version: 1.0.0
 277 homepage: http://test.org
 278 synopsis: synopsis
 279 description: description
 280 license: BSD3
 281 executable cabal
 282     build-depends:
 283       HTTP       >= 4000.2.5 && < 4000.3,
 284       mtl        >= 2.0      && < 3
 285   ghc-options: -Wall
 286 ")
 287
 288 ;; Fails: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35743
 289 (test-expect-fail 1)
 290 (test-assert "hackage->guix-package test mixed layout"
 291   (eval-test-with-cabal test-cabal-mixed-layout match-ghc-foo))
 292
 293 ;; Check flag executable. Compare e.g. darcs.
 294 (define test-cabal-flag-executable
 295   "name: foo
 296 version: 1.0.0
 297 homepage: http://test.org
 298 synopsis: synopsis
 299 description: description
 300 license: BSD3
 301 flag executable
 302   description: Build executable
 303   default:     True
 304 executable cabal
 305   if !flag(executable)
 306     buildable: False
 307   else
 308     buildable: True
 309
 310   build-depends:
 311     HTTP       >= 4000.2.5 && < 4000.3,
 312     mtl        >= 2.0      && < 3
 313 ")
 314
 315 (test-assert "hackage->guix-package test flag executable"
 316   (eval-test-with-cabal test-cabal-flag-executable match-ghc-foo))
 317
 318 ;; Check Hackage Cabal revisions.
 319 (define test-cabal-revision
 320   "name: foo
 321 version: 1.0.0
 322 x-revision: 2
 323 homepage: http://test.org
 324 synopsis: synopsis
 325 description: description
 326 license: BSD3
 327 executable cabal
 328   build-depends:
 329     HTTP       >= 4000.2.5 && < 4000.3,
 330     mtl        >= 2.0      && < 3
 331 ")
 332
 333 (define-package-matcher match-ghc-foo-revision
 334   ('package
 335     ('name "ghc-foo")
 336     ('version "1.0.0")
 337     ('source
 338      ('origin
 339        ('method 'url-fetch)
 340        ('uri ('string-append
 341               "https://hackage.haskell.org/package/foo/foo-"
 342               'version
 343               ".tar.gz"))
 344        ('sha256
 345         ('base32
 346          (? string? hash)))))
 347     ('build-system 'haskell-build-system)
 348     ('inputs ('list 'ghc-http))
 349     ('arguments
 350      ('quasiquote
 351       ('#:cabal-revision
 352        ("2" "0xxd88fb659f0krljidbvvmkh9ppjnx83j0nqzx8whcg4n5qbyng"))))
 353     ('home-page "http://test.org")
 354     ('synopsis (? string?))
 355     ('description (? string?))
 356     ('license 'license:bsd-3)))
 357
 358 (test-assert "hackage->guix-package test cabal revision"
 359   (eval-test-with-cabal test-cabal-revision match-ghc-foo-revision))
 360
 361 (test-assert "read-cabal test 1"
 362   (match (call-with-input-string test-read-cabal-1 read-cabal)
 363     ((("name" ("test-me"))
 364       ('section 'library
 365                 (('if ('flag "base4point8")
 366                       (("build-depends" ("base >= 4.8 && < 5")))
 367                       (('if ('flag "base4")
 368                             (("build-depends" ("base >= 4 && < 4.8")))
 369                             (('if ('flag "base3")
 370                                   (("build-depends" ("base >= 3 && < 4")))
 371                                   (("build-depends" ("base < 3"))))))))
 372                  ('if ('or ('flag "base4point8")
 373                            ('and ('flag "base4") ('flag "base3")))
 374                       (("build-depends" ("random")))
 375                       ())
 376                  ("build-depends" ("containers"))
 377                  ("exposed-modules" ("Test.QuickCheck.Exception")))))
 378      #t)
 379     (x (pk 'fail x #f))))
 380
 381 (define test-cabal-import
 382   "name: foo
 383 version: 1.0.0
 384 homepage: http://test.org
 385 synopsis: synopsis
 386 description: description
 387 license: BSD3
 388 common commons
 389   build-depends:
 390     HTTP       >= 4000.2.5 && < 4000.3,
 391     mtl        >= 2.0      && < 3
 392
 393 executable cabal
 394   import: commons
 395 ")
 396
 397 (define-package-matcher match-ghc-foo-import
 398   ('package
 399     ('name "ghc-foo")
 400     ('version "1.0.0")
 401     ('source
 402      ('origin
 403        ('method 'url-fetch)
 404        ('uri ('string-append
 405               "https://hackage.haskell.org/package/foo/foo-"
 406               'version
 407               ".tar.gz"))
 408        ('sha256
 409         ('base32
 410          (? string? hash)))))
 411     ('build-system 'haskell-build-system)
 412     ('inputs ('list 'ghc-http))
 413     ('home-page "http://test.org")
 414     ('synopsis (? string?))
 415     ('description (? string?))
 416     ('license 'license:bsd-3)))
 417
 418 (test-assert "hackage->guix-package test cabal import"
 419   (eval-test-with-cabal test-cabal-import match-ghc-foo-import))
 420
 421 (test-end "hackage")