aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilip Munksgaard <philip@munksgaard.me>2021-06-18 14:48:13 +0200
committerLudovic Courtès <ludo@gnu.org>2021-06-25 15:12:05 +0200
commitdfac3e643a924ccefc997b4433a0b5c35928d657 (patch)
tree3b2d9ff4c6753b90eed90cbef63cd510d65dcf01
parent7916201c4da9a29abc0ac1ef3ee80c8e3efdcf72 (diff)
import: hackage: Support "common" field and imports
Fixes <https://issues.guix.gnu.org/48701>. * guix/import/cabal.scm (make-cabal-parser): Modify. (is-common): New variable. (lex-common): New procedure. (is-id): Modify. (eval-cabal): Modify. * tests/hackage.scm ("hackage->guix-package test cabal import") New test. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
-rw-r--r--guix/import/cabal.scm27
-rw-r--r--tests/hackage.scm42
2 files changed, 67 insertions, 2 deletions
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index da00019297..e9a0179b3d 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -145,7 +145,7 @@ to the stack."
(lalr-parser
;; --- token definitions
(CCURLY VCCURLY OPAREN CPAREN TEST ID VERSION RELATION TRUE FALSE -ANY -NONE
- (right: IF FLAG EXEC TEST-SUITE CUSTOM-SETUP SOURCE-REPO BENCHMARK LIB OCURLY)
+ (right: IF FLAG EXEC TEST-SUITE CUSTOM-SETUP SOURCE-REPO BENCHMARK LIB COMMON OCURLY)
(left: OR)
(left: PROPERTY AND)
(right: ELSE NOT))
@@ -155,6 +155,7 @@ to the stack."
(sections source-repo) : (append $1 (list $2))
(sections executables) : (append $1 $2)
(sections test-suites) : (append $1 $2)
+ (sections common) : (append $1 $2)
(sections custom-setup) : (append $1 $2)
(sections benchmarks) : (append $1 $2)
(sections lib-sec) : (append $1 (list $2))
@@ -178,6 +179,10 @@ to the stack."
(ts-sec) : (list $1))
(ts-sec (TEST-SUITE OCURLY exprs CCURLY) : `(section test-suite ,$1 ,$3)
(TEST-SUITE open exprs close) : `(section test-suite ,$1 ,$3))
+ (common (common common-sec) : (append $1 (list $2))
+ (common-sec) : (list $1))
+ (common-sec (COMMON OCURLY exprs CCURLY) : `(section common ,$1 ,$3)
+ (COMMON open exprs close) : `(section common ,$1 ,$3))
(custom-setup (CUSTOM-SETUP exprs) : (list `(section custom-setup ,$1 ,$2)))
(benchmarks (benchmarks bm-sec) : (append $1 (list $2))
(bm-sec) : (list $1))
@@ -367,6 +372,9 @@ matching a string against the created regexp."
(define is-test-suite (make-rx-matcher "^test-suite +([a-z0-9_-]+)"
regexp/icase))
+(define is-common (make-rx-matcher "^common +([a-z0-9_-]+)"
+ regexp/icase))
+
(define is-custom-setup (make-rx-matcher "^(custom-setup)"
regexp/icase))
@@ -394,7 +402,7 @@ matching a string against the created regexp."
(define (is-id s port)
(let ((cabal-reserved-words
'("if" "else" "library" "flag" "executable" "test-suite" "custom-setup"
- "source-repository" "benchmark"))
+ "source-repository" "benchmark" "common"))
(spaces (read-while (cut char-set-contains? char-set:blank <>) port))
(c (peek-char port)))
(unread-string spaces port)
@@ -469,6 +477,8 @@ string with the read characters."
(define (lex-test-suite ts-rx-res loc) (lex-rx-res ts-rx-res 'TEST-SUITE loc))
+(define (lex-common common-rx-res loc) (lex-rx-res common-rx-res 'COMMON loc))
+
(define (lex-custom-setup ts-rx-res loc) (lex-rx-res ts-rx-res 'CUSTOM-SETUP loc))
(define (lex-benchmark bm-rx-res loc) (lex-rx-res bm-rx-res 'BENCHMARK loc))
@@ -570,6 +580,7 @@ the current port location."
((is-src-repo s) => (cut lex-src-repo <> loc))
((is-exec s) => (cut lex-exec <> loc))
((is-test-suite s) => (cut lex-test-suite <> loc))
+ ((is-common s) => (cut lex-common <> loc))
((is-custom-setup s) => (cut lex-custom-setup <> loc))
((is-benchmark s) => (cut lex-benchmark <> loc))
((is-lib s) (lex-lib loc))
@@ -796,7 +807,16 @@ the ordering operation and the version."
(let ((value (or (assoc-ref env name)
(assoc-ref (cabal-flags->alist (cabal-flags)) name))))
(if (eq? value 'false) #f #t)))
+
+ (define common-stanzas
+ (filter-map (match-lambda
+ (('section 'common common-name common)
+ (cons common-name common))
+ (_ #f))
+ cabal-sexp))
+
(define (eval sexp)
+ "Given an SEXP and an ENV, return the evaluated (SEXP . ENV)."
(match sexp
(() '())
;; nested 'if'
@@ -831,6 +851,9 @@ the ordering operation and the version."
(list 'section type name (eval parameters)))
(((? string? name) values)
(list name values))
+ ((("import" imports) rest ...)
+ (eval (append (append-map (cut assoc-ref common-stanzas <>) imports)
+ rest)))
((element rest ...)
(cons (eval element) (eval rest)))
(_ (raise (condition
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 66a13d9881..53972fc643 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -388,4 +388,46 @@ executable cabal
#t)
(x (pk 'fail x #f))))
+(define test-cabal-import
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+common commons
+ build-depends:
+ HTTP >= 4000.2.5 && < 4000.3,
+ mtl >= 2.0 && < 3
+
+executable cabal
+ import: commons
+")
+
+(define-package-matcher match-ghc-foo-import
+ ('package
+ ('name "ghc-foo")
+ ('version "1.0.0")
+ ('source
+ ('origin
+ ('method 'url-fetch)
+ ('uri ('string-append
+ "https://hackage.haskell.org/package/foo/foo-"
+ 'version
+ ".tar.gz"))
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'haskell-build-system)
+ ('inputs
+ ('quasiquote
+ (("ghc-http" ('unquote 'ghc-http)))))
+ ('home-page "http://test.org")
+ ('synopsis (? string?))
+ ('description (? string?))
+ ('license 'license:bsd-3)))
+
+(test-assert "hackage->guix-package test cabal import"
+ (eval-test-with-cabal test-cabal-import match-ghc-foo-import))
+
(test-end "hackage")