diff options
-rw-r--r-- | guix/import/cabal.scm | 27 | ||||
-rw-r--r-- | tests/hackage.scm | 42 |
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") |