tests/hackage.scm

   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)
  20   #:use-module (guix import cabal)
  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
  39 (define test-cabal-2
  40   "name: foo
  41 version: 1.0.0
  42 homepage: http://test.org
  43 synopsis: synopsis
  44 description: description
  45 license: BSD3
  46 executable cabal {
  47 build-depends:
  48   HTTP       >= 4000.2.5 && < 4000.3,
  49   mtl        >= 2.0      && < 3
  50 }
  51 ")
  52
  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
  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
 131 ;; A fragment of a real Cabal file with minor modification to check precedence
 132 ;; of 'and' over 'or', missing final newline, spaces between keywords and
 133 ;; parentheses and between key and column.
 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
 148   if flag(base4point8) || flag (base4) && flag(base3)
 149     Build-depends: random
 150   Build-depends : containers
 151
 152   -- Modules that are always built.
 153   Exposed-Modules:
 154     Test.QuickCheck.Exception")
 155
 156 (test-begin "hackage")
 157
 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
 181       (("ghc-http" ('unquote 'ghc-http)))))
 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 '()))
 188   (define port (open-input-string test-cabal))
 189   (matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)))
 190
 191 (test-assert "hackage->guix-package test 1"
 192   (eval-test-with-cabal test-cabal-1 match-ghc-foo))
 193
 194 (test-assert "hackage->guix-package test 2"
 195   (eval-test-with-cabal test-cabal-2 match-ghc-foo))
 196
 197 (test-assert "hackage->guix-package test 3"
 198   (eval-test-with-cabal test-cabal-3 match-ghc-foo
 199                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 200
 201 (test-assert "hackage->guix-package test 4"
 202   (eval-test-with-cabal test-cabal-4 match-ghc-foo
 203                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 204
 205 (test-assert "hackage->guix-package test 5"
 206   (eval-test-with-cabal test-cabal-5 match-ghc-foo
 207                         #:cabal-environment '(("impl" . "ghc-7.8"))))
 208
 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))
 227        ("ghc-http" ('unquote 'ghc-http)))))
 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
 236 (test-assert "hackage->guix-package test 6"
 237   (eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
 238
 239 ;; Check multi-line layouted description
 240 (define test-cabal-multiline-layout
 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
 254 (test-assert "hackage->guix-package test multiline desc (layout)"
 255   (eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo))
 256
 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))
 276
 277 ;; Check Hackage Cabal revisions.
 278 (define test-cabal-revision
 279   "name: foo
 280 version: 1.0.0
 281 x-revision: 2
 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 ")
 291
 292 (define-package-matcher match-ghc-foo-revision
 293   ('package
 294     ('name "ghc-foo")
 295     ('version "1.0.0")
 296     ('source
 297      ('origin
 298        ('method 'url-fetch)
 299        ('uri ('string-append
 300               "https://hackage.haskell.org/package/foo/foo-"
 301               'version
 302               ".tar.gz"))
 303        ('sha256
 304         ('base32
 305          (? string? hash)))))
 306     ('build-system 'haskell-build-system)
 307     ('inputs
 308      ('quasiquote
 309       (("ghc-http" ('unquote 'ghc-http)))))
 310     ('arguments
 311      ('quasiquote
 312       ('#:cabal-revision
 313        ("2" "0xxd88fb659f0krljidbvvmkh9ppjnx83j0nqzx8whcg4n5qbyng"))))
 314     ('home-page "http://test.org")
 315     ('synopsis (? string?))
 316     ('description (? string?))
 317     ('license 'bsd-3)))
 318
 319 (test-assert "hackage->guix-package test cabal revision"
 320   (eval-test-with-cabal test-cabal-revision match-ghc-foo-revision))
 321
 322 (test-assert "read-cabal test 1"
 323   (match (call-with-input-string test-read-cabal-1 read-cabal)
 324     ((("name" ("test-me"))
 325       ('section 'library
 326                 (('if ('flag "base4point8")
 327                       (("build-depends" ("base >= 4.8 && < 5")))
 328                       (('if ('flag "base4")
 329                             (("build-depends" ("base >= 4 && < 4.8")))
 330                             (('if ('flag "base3")
 331                                   (("build-depends" ("base >= 3 && < 4")))
 332                                   (("build-depends" ("base < 3"))))))))
 333                  ('if ('or ('flag "base4point8")
 334                            ('and ('flag "base4") ('flag "base3")))
 335                       (("build-depends" ("random")))
 336                       ())
 337                  ("build-depends" ("containers"))
 338                  ("exposed-modules" ("Test.QuickCheck.Exception")))))
 339      #t)
 340     (x (pk 'fail x #f))))
 341
 342 (test-end "hackage")