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 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (test-hackage)
  21   #:use-module (guix import cabal)
  22   #:use-module (guix import hackage)
  23   #:use-module (guix tests)
  24   #:use-module (srfi srfi-64)
  25   #:use-module (ice-9 match))
  26
  27 (define test-cabal-1
  28   "name: foo
  29 version: 1.0.0
  30 homepage: http://test.org
  31 synopsis: synopsis
  32 description: description
  33 license: BSD3
  34 executable cabal
  35   build-depends:
  36     HTTP       >= 4000.2.5 && < 4000.3,
  37     mtl        >= 2.0      && < 3
  38 ")
  39
  40 (define test-cabal-2
  41   "name: foo
  42 version: 1.0.0
  43 homepage: http://test.org
  44 synopsis: synopsis
  45 description: description
  46 license: BSD3
  47 executable cabal {
  48 build-depends:
  49   HTTP       >= 4000.2.5 && < 4000.3,
  50   mtl        >= 2.0      && < 3
  51 }
  52 ")
  53
  54 ;; Check compiler implementation test with and without spaces.
  55 (define test-cabal-3
  56   "name: foo
  57 version: 1.0.0
  58 homepage: http://test.org
  59 synopsis: synopsis
  60 description: description
  61 license: BSD3
  62 library
  63   if impl(ghc >= 7.2 && < 7.6)
  64     Build-depends: ghc-a
  65   if impl(ghc>=7.2&&<7.6)
  66     Build-depends: ghc-b
  67   if impl(ghc == 7.8)
  68     Build-depends:
  69       HTTP       >= 4000.2.5 && < 4000.3,
  70       mtl        >= 2.0      && < 3
  71 ")
  72
  73 ;; Check "-any", "-none" when name is different.
  74 (define test-cabal-4
  75   "name: foo
  76 version: 1.0.0
  77 homepage: http://test.org
  78 synopsis: synopsis
  79 description: description
  80 license: BSD3
  81 library
  82   if impl(ghcjs -any)
  83     Build-depends: ghc-a
  84   if impl(ghc>=7.2&&<7.6)
  85     Build-depends: ghc-b
  86   if impl(ghc == 7.8)
  87     Build-depends:
  88       HTTP       >= 4000.2.5 && < 4000.3,
  89       mtl        >= 2.0      && < 3
  90 ")
  91
  92 ;; Check "-any", "-none".
  93 (define test-cabal-5
  94   "name: foo
  95 version: 1.0.0
  96 homepage: http://test.org
  97 synopsis: synopsis
  98 description: description
  99 license: BSD3
 100 library
 101   if impl(ghc == 7.8)
 102     Build-depends:
 103       HTTP       >= 4000.2.5 && < 4000.3,
 104   if impl(ghc -any)
 105     Build-depends: mtl        >= 2.0      && < 3
 106   if impl(ghc>=7.2&&<7.6)
 107     Build-depends: ghc-b
 108 ")
 109
 110 ;; Check "custom-setup".
 111 (define test-cabal-6
 112   "name: foo
 113 build-type: Custom
 114 version: 1.0.0
 115 homepage: http://test.org
 116 synopsis: synopsis
 117 description: description
 118 license: BSD3
 119 custom-setup
 120   setup-depends: base >= 4.7 && < 5,
 121                  Cabal >= 1.24,
 122                  haskell-gi == 0.21.*
 123 library
 124   if impl(ghc>=7.2&&<7.6)
 125     Build-depends: ghc-b
 126   if impl(ghc == 7.8)
 127     Build-depends:
 128       HTTP       >= 4000.2.5 && < 4000.3,
 129       mtl        >= 2.0      && < 3
 130 ")
 131
 132 ;; A fragment of a real Cabal file with minor modification to check precedence
 133 ;; of 'and' over 'or', missing final newline, spaces between keywords and
 134 ;; parentheses and between key and column.
 135 (define test-read-cabal-1
 136   "name: test-me
 137 library
 138   -- Choose which library versions to use.
 139   if flag(base4point8)
 140     Build-depends: base >= 4.8 && < 5
 141   else
 142     if flag(base4)
 143       Build-depends: base >= 4 && < 4.8
 144     else
 145       if flag(base3)
 146         Build-depends: base >= 3 && < 4
 147       else
 148         Build-depends: base < 3
 149   if flag(base4point8) || flag (base4) && flag(base3)
 150     Build-depends: random
 151   Build-depends : containers
 152
 153   -- Modules that are always built.
 154   Exposed-Modules:
 155     Test.QuickCheck.Exception")
 156
 157 (test-begin "hackage")
 158
 159 (define-syntax-rule (define-package-matcher name pattern)
 160   (define* (name obj)
 161     (match obj
 162       (pattern #t)
 163       (x       (pk 'fail x #f)))))
 164
 165 (define-package-matcher match-ghc-foo
 166   ('package
 167     ('name "ghc-foo")
 168     ('version "1.0.0")
 169     ('source
 170      ('origin
 171        ('method 'url-fetch)
 172        ('uri ('string-append
 173               "https://hackage.haskell.org/package/foo/foo-"
 174               'version
 175               ".tar.gz"))
 176        ('sha256
 177         ('base32
 178          (? string? hash)))))
 179     ('build-system 'haskell-build-system)
 180     ('inputs
 181      ('quasiquote
 182       (("ghc-http" ('unquote 'ghc-http)))))
 183     ('home-page "http://test.org")
 184     ('synopsis (? string?))
 185     ('description (? string?))
 186     ('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
 226      ('quasiquote
 227       (("ghc-b" ('unquote 'ghc-b))
 228        ("ghc-http" ('unquote 'ghc-http)))))
 229     ('native-inputs
 230      ('quasiquote
 231       (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi)))))
 232     ('home-page "http://test.org")
 233     ('synopsis (? string?))
 234     ('description (? string?))
 235     ('license 'bsd-3)))
 236
 237 (test-assert "hackage->guix-package test 6"
 238   (eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
 239
 240 ;; Check multi-line layouted description.
 241 (define test-cabal-multiline-layout
 242   "name: foo
 243 version: 1.0.0
 244 homepage: http://test.org
 245 synopsis: synopsis
 246 description:   first line
 247                second line
 248 license: BSD3
 249 executable cabal
 250   build-depends:
 251     HTTP       >= 4000.2.5 && < 4000.3,
 252     mtl        >= 2.0      && < 3
 253 ")
 254
 255 (test-assert "hackage->guix-package test multiline desc (layout)"
 256   (eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo))
 257
 258 ;; Check multi-line braced description.
 259 (define test-cabal-multiline-braced
 260   "name: foo
 261 version: 1.0.0
 262 homepage: http://test.org
 263 synopsis: synopsis
 264 description: {
 265 first line
 266 second line
 267 }
 268 license: BSD3
 269 executable cabal
 270   build-depends:
 271     HTTP       >= 4000.2.5 && < 4000.3,
 272     mtl        >= 2.0      && < 3
 273 ")
 274
 275 (test-assert "hackage->guix-package test multiline desc (braced)"
 276   (eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo))
 277
 278 ;; Check mixed layout. Compare e.g. warp.
 279 (define test-cabal-mixed-layout
 280   "name: foo
 281 version: 1.0.0
 282 homepage: http://test.org
 283 synopsis: synopsis
 284 description: description
 285 license: BSD3
 286 executable cabal
 287     build-depends:
 288       HTTP       >= 4000.2.5 && < 4000.3,
 289       mtl        >= 2.0      && < 3
 290   ghc-options: -Wall
 291 ")
 292
 293 ;; Fails: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35743
 294 (test-expect-fail 1)
 295 (test-assert "hackage->guix-package test mixed layout"
 296   (eval-test-with-cabal test-cabal-mixed-layout match-ghc-foo))
 297
 298 ;; Check flag executable. Compare e.g. darcs.
 299 (define test-cabal-flag-executable
 300   "name: foo
 301 version: 1.0.0
 302 homepage: http://test.org
 303 synopsis: synopsis
 304 description: description
 305 license: BSD3
 306 flag executable
 307   description: Build executable
 308   default:     True
 309 executable cabal
 310   if !flag(executable)
 311     buildable: False
 312   else
 313     buildable: True
 314
 315   build-depends:
 316     HTTP       >= 4000.2.5 && < 4000.3,
 317     mtl        >= 2.0      && < 3
 318 ")
 319
 320 ;; Fails: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25138
 321 (test-expect-fail 1)
 322 (test-assert "hackage->guix-package test flag executable"
 323   (eval-test-with-cabal test-cabal-flag-executable match-ghc-foo))
 324
 325 ;; Check Hackage Cabal revisions.
 326 (define test-cabal-revision
 327   "name: foo
 328 version: 1.0.0
 329 x-revision: 2
 330 homepage: http://test.org
 331 synopsis: synopsis
 332 description: description
 333 license: BSD3
 334 executable cabal
 335   build-depends:
 336     HTTP       >= 4000.2.5 && < 4000.3,
 337     mtl        >= 2.0      && < 3
 338 ")
 339
 340 (define-package-matcher match-ghc-foo-revision
 341   ('package
 342     ('name "ghc-foo")
 343     ('version "1.0.0")
 344     ('source
 345      ('origin
 346        ('method 'url-fetch)
 347        ('uri ('string-append
 348               "https://hackage.haskell.org/package/foo/foo-"
 349               'version
 350               ".tar.gz"))
 351        ('sha256
 352         ('base32
 353          (? string? hash)))))
 354     ('build-system 'haskell-build-system)
 355     ('inputs
 356      ('quasiquote
 357       (("ghc-http" ('unquote 'ghc-http)))))
 358     ('arguments
 359      ('quasiquote
 360       ('#:cabal-revision
 361        ("2" "0xxd88fb659f0krljidbvvmkh9ppjnx83j0nqzx8whcg4n5qbyng"))))
 362     ('home-page "http://test.org")
 363     ('synopsis (? string?))
 364     ('description (? string?))
 365     ('license 'bsd-3)))
 366
 367 (test-assert "hackage->guix-package test cabal revision"
 368   (eval-test-with-cabal test-cabal-revision match-ghc-foo-revision))
 369
 370 (test-assert "read-cabal test 1"
 371   (match (call-with-input-string test-read-cabal-1 read-cabal)
 372     ((("name" ("test-me"))
 373       ('section 'library
 374                 (('if ('flag "base4point8")
 375                       (("build-depends" ("base >= 4.8 && < 5")))
 376                       (('if ('flag "base4")
 377                             (("build-depends" ("base >= 4 && < 4.8")))
 378                             (('if ('flag "base3")
 379                                   (("build-depends" ("base >= 3 && < 4")))
 380                                   (("build-depends" ("base < 3"))))))))
 381                  ('if ('or ('flag "base4point8")
 382                            ('and ('flag "base4") ('flag "base3")))
 383                       (("build-depends" ("random")))
 384                       ())
 385                  ("build-depends" ("containers"))
 386                  ("exposed-modules" ("Test.QuickCheck.Exception")))))
 387      #t)
 388     (x (pk 'fail x #f))))
 389
 390 (test-end "hackage")