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 hackage)
  21   #:use-module (guix tests)
  22   #:use-module (srfi srfi-64)
  23   #:use-module (ice-9 match))
  24
  25 (define test-cabal-1
  26   "name: foo
  27 version: 1.0.0
  28 homepage: http://test.org
  29 synopsis: synopsis
  30 description: description
  31 license: BSD3
  32 executable cabal
  33   build-depends:
  34     HTTP       >= 4000.2.5 && < 4000.3,
  35     mtl        >= 2.0      && < 3
  36 ")
  37
  38 ;; Use TABs to indent lines and to separate keys from value.
  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:  HTTP       >= 4000.2.5 && < 4000.3,
  48                 mtl        >= 2.0      && < 3
  49 ")
  50
  51 ;; Use indentation with comma as found, e.g., in 'haddock-api'.
  52 (define test-cabal-3
  53   "name: foo
  54 version: 1.0.0
  55 homepage: http://test.org
  56 synopsis: synopsis
  57 description: description
  58 license: BSD3
  59 executable cabal
  60     build-depends:
  61         HTTP       >= 4000.2.5 && < 4000.3
  62       , mtl        >= 2.0      && < 3
  63 ")
  64
  65 (define test-cond-1
  66   "(os(darwin) || !(flag(debug))) && flag(cips)")
  67
  68 (define read-cabal
  69   (@@ (guix import hackage) read-cabal))
  70
  71 (define eval-cabal-keywords
  72   (@@ (guix import hackage) eval-cabal-keywords))
  73
  74 (define conditional->sexp-like
  75   (@@ (guix import hackage) conditional->sexp-like))
  76
  77 (test-begin "hackage")
  78
  79 (define (eval-test-with-cabal test-cabal)
  80   (mock
  81    ((guix import hackage) hackage-fetch
  82     (lambda (name-version)
  83       (call-with-input-string test-cabal
  84         read-cabal)))
  85    (match (hackage->guix-package "foo")
  86      (('package
  87         ('name "ghc-foo")
  88         ('version "1.0.0")
  89         ('source
  90          ('origin
  91            ('method 'url-fetch)
  92            ('uri ('string-append
  93                   "http://hackage.haskell.org/package/foo/foo-"
  94                   'version
  95                   ".tar.gz"))
  96            ('sha256
  97             ('base32
  98              (? string? hash)))))
  99         ('build-system 'haskell-build-system)
 100         ('inputs
 101          ('quasiquote
 102           (("ghc-http" ('unquote 'ghc-http))
 103            ("ghc-mtl" ('unquote 'ghc-mtl)))))
 104         ('home-page "http://test.org")
 105         ('synopsis (? string?))
 106         ('description (? string?))
 107         ('license 'bsd-3))
 108       #t)
 109      (x
 110       (pk 'fail x #f)))))
 111
 112 (test-assert "hackage->guix-package test 1"
 113   (eval-test-with-cabal test-cabal-1))
 114
 115 (test-assert "hackage->guix-package test 2"
 116   (eval-test-with-cabal test-cabal-2))
 117
 118 (test-assert "hackage->guix-package test 3"
 119   (eval-test-with-cabal test-cabal-3))
 120
 121 (test-assert "conditional->sexp-like"
 122   (match
 123     (eval-cabal-keywords
 124      (conditional->sexp-like test-cond-1)
 125      '(("debug" . "False")))
 126     (('and ('or ('string-match "darwin" ('%current-system)) ('not '#f)) '#t)
 127      #t)
 128     (x
 129      (pk 'fail x #f))))
 130
 131 (test-end "hackage")
 132
 133 \f
 134 (exit (= (test-runner-fail-count (test-runner-current)) 0))