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 ;; A fragment of a real Cabal file with minor modification to check precedence
  54 ;; of 'and' over 'or'.
  55 (define test-read-cabal-1
  56   "name: test-me
  57 library
  58   -- Choose which library versions to use.
  59   if flag(base4point8)
  60     Build-depends: base >= 4.8 && < 5
  61   else
  62     if flag(base4)
  63       Build-depends: base >= 4 && < 4.8
  64     else
  65       if flag(base3)
  66         Build-depends: base >= 3 && < 4
  67       else
  68         Build-depends: base < 3
  69   if flag(base4point8) || flag(base4) && flag(base3)
  70     Build-depends: random
  71   Build-depends: containers
  72
  73   -- Modules that are always built.
  74   Exposed-Modules:
  75     Test.QuickCheck.Exception
  76 ")
  77
  78 (test-begin "hackage")
  79
  80 (define (eval-test-with-cabal test-cabal)
  81   (mock
  82    ((guix import hackage) hackage-fetch
  83     (lambda (name-version)
  84       (call-with-input-string test-cabal
  85         read-cabal)))
  86    (match (hackage->guix-package "foo")
  87      (('package
  88         ('name "ghc-foo")
  89         ('version "1.0.0")
  90         ('source
  91          ('origin
  92            ('method 'url-fetch)
  93            ('uri ('string-append
  94                   "http://hackage.haskell.org/package/foo/foo-"
  95                   'version
  96                   ".tar.gz"))
  97            ('sha256
  98             ('base32
  99              (? string? hash)))))
 100         ('build-system 'haskell-build-system)
 101         ('inputs
 102          ('quasiquote
 103           (("ghc-http" ('unquote 'ghc-http))
 104            ("ghc-mtl" ('unquote 'ghc-mtl)))))
 105         ('home-page "http://test.org")
 106         ('synopsis (? string?))
 107         ('description (? string?))
 108         ('license 'bsd-3))
 109       #t)
 110      (x
 111       (pk 'fail x #f)))))
 112
 113 (test-assert "hackage->guix-package test 1"
 114   (eval-test-with-cabal test-cabal-1))
 115
 116 (test-assert "hackage->guix-package test 2"
 117   (eval-test-with-cabal test-cabal-2))
 118
 119 (test-assert "read-cabal test 1"
 120   (match (call-with-input-string test-read-cabal-1 read-cabal)
 121     ((("name" ("test-me"))
 122       ('section 'library
 123                (('if ('flag "base4point8")
 124                     (("build-depends" ("base >= 4.8 && < 5")))
 125                     (('if ('flag "base4")
 126                          (("build-depends" ("base >= 4 && < 4.8")))
 127                          (('if ('flag "base3")
 128                               (("build-depends" ("base >= 3 && < 4")))
 129                               (("build-depends" ("base < 3"))))))))
 130                 ('if ('or ('flag "base4point8")
 131                           ('and ('flag "base4") ('flag "base3")))
 132                     (("build-depends" ("random")))
 133                     ())
 134                 ("build-depends" ("containers"))
 135                 ("exposed-modules" ("Test.QuickCheck.Exception")))))
 136      #t)
 137     (x (pk 'fail x #f))))
 138
 139 (test-end "hackage")
 140
 141 \f
 142 (exit (= (test-runner-fail-count (test-runner-current)) 0))