From c3fbaee34548fbfb1617dc7fccc94c598efbd7a6 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Sun, 22 May 2022 10:56:01 +0200 Subject: [PATCH] import: cabal: Support library names * guix/import/cabal.scm (make-cabal-parser): Add name to section. (is-lib): Add optional name to regular expression. (lex-rx-res): Support selecting different substring. (lex-lib): Match 2nd substring from IS-LIB. (lex-line): Adapt to changes for lex-lib. (cabal-library): Add name field and export CABAL-LIBRARY-NAME. (eval): Remove special case for 'library, which is not required any more. (make-cabal-section): Move special case for LIBRARY. * tests/hackage.scm (test-read-cabal-library-name): New variable. ("read-cabal test 1"): Adapt testcase to changed internal structure. ("read-cabal test: library name"): New testcase. --- guix/import/cabal.scm | 27 ++++++++++++++------------- tests/hackage.scm | 21 ++++++++++++++++++++- 2 files changed, 34 insertions(+), 14 deletions(-) diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm index 8f59a63cb9..4410c12500 100644 --- a/guix/import/cabal.scm +++ b/guix/import/cabal.scm @@ -74,6 +74,7 @@ (define-module (guix import cabal) cabal-executable-dependencies cabal-library? + cabal-library-name cabal-library-dependencies cabal-test-suite? @@ -189,8 +190,8 @@ (define (make-cabal-parser) (bm-sec) : (list $1)) (bm-sec (BENCHMARK OCURLY exprs CCURLY) : `(section benchmark ,$1 ,$3) (BENCHMARK open exprs close) : `(section benchmark ,$1 ,$3)) - (lib-sec (LIB OCURLY exprs CCURLY) : `(section library ,$3) - (LIB open exprs close) : `(section library ,$3)) + (lib-sec (LIB OCURLY exprs CCURLY) : `(section library ,$1 ,$3) + (LIB open exprs close) : `(section library ,$1 ,$3)) (exprs (exprs PROPERTY) : (append $1 (list $2)) (PROPERTY) : (list $1) (exprs elif-else) : (append $1 (list ($2 '(())))) @@ -382,7 +383,8 @@ (define is-custom-setup (make-rx-matcher "^(custom-setup)" (define is-benchmark (make-rx-matcher "^benchmark +([a-z0-9_-]+)" regexp/icase)) -(define is-lib (make-rx-matcher "^library *" regexp/icase)) +;; Libraries can have optional names since Cabal 2.0. +(define is-lib (make-rx-matcher "^library(\\s+([a-z0-9_-]+))?\\s*" regexp/icase)) (define (is-else s) (string-ci=? s "else")) @@ -476,8 +478,9 @@ (define (lex-braced-property k-rx-res loc port) 'PROPERTY loc (list key `(,(read-braced-value port)))))) -(define (lex-rx-res rx-res token loc) - (let ((name (string-downcase (match:substring rx-res 1)))) +(define* (lex-rx-res rx-res token loc #:optional (substring-id 1)) + (let* ((match (match:substring rx-res substring-id)) + (name (if match (string-downcase match) match))) (make-lexical-token token loc name))) (define (lex-flag flag-rx-res loc) (lex-rx-res flag-rx-res 'FLAG loc)) @@ -495,7 +498,7 @@ (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)) -(define (lex-lib loc) (make-lexical-token 'LIB loc #f)) +(define (lex-lib lib-rx-res loc) (lex-rx-res lib-rx-res 'LIB loc 2)) (define (lex-else loc) (make-lexical-token 'ELSE loc #f)) @@ -599,7 +602,7 @@ (define (lex-line port 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)) + ((is-lib s) => (cut lex-lib <> loc)) (else (unread-string s port) #f)))) (define (lex-property port loc) @@ -729,8 +732,9 @@ (define-record-type (dependencies cabal-executable-dependencies)) ; list of (define-record-type - (make-cabal-library dependencies) + (make-cabal-library name dependencies) cabal-library? + (name cabal-library-name) (dependencies cabal-library-dependencies)) ; list of (define-record-type @@ -861,9 +865,6 @@ (define (eval sexp) (list 'section 'flag name parameters)) (('section 'custom-setup parameters) (list 'section 'custom-setup parameters)) - ;; library does not have a name parameter - (('section 'library parameters) - (list 'section 'library (eval parameters))) (('section type name parameters) (list 'section type name (eval parameters))) (((? string? name) values) @@ -923,6 +924,8 @@ (define (make-cabal-section sexp section-type) name (lookup-join parameters "type") (lookup-join parameters "location"))) + ((library) (make-cabal-library name + (dependencies parameters))) ((flag) (let* ((default (lookup-join parameters "default")) (default-true-or-false @@ -939,8 +942,6 @@ (define (make-cabal-section sexp section-type) default-true-or-false manual-true-or-false))) (else #f))) - (('section (? (cut equal? <> section-type) lib) parameters) - (make-cabal-library (dependencies parameters))) (_ #f)) sexp)) diff --git a/tests/hackage.scm b/tests/hackage.scm index d7ecd0cc21..85a5c2115c 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -172,6 +172,15 @@ (define test-read-cabal-brackets-newline } ") +;; Test library with (since Cabal 2.0) and without names. +(define test-read-cabal-library-name + "name: test-me +library foobar + build-depends: foo, bar +library + build-depends: bar, baz +") + (test-begin "hackage") (define-syntax-rule (define-package-matcher name pattern) @@ -507,7 +516,7 @@ (define-package-matcher match-ghc-foo-revision (test-assert "read-cabal test 1" (match (call-with-input-string test-read-cabal-1 read-cabal) ((("name" ("test-me")) - ('section 'library + ('section 'library #f (('if ('flag "base4point8") (("build-depends" ("base >= 4.8 && < 5"))) (('if ('flag "base4") @@ -543,6 +552,16 @@ (define-package-matcher match-ghc-foo-revision #t) (x (pk 'fail x #f)))) +(test-assert "read-cabal test: library name" + (match (call-with-input-string test-read-cabal-library-name read-cabal) + ((("name" ("test-me")) + ('section 'library "foobar" + (("build-depends" ("foo, bar")))) + ('section 'library #f + (("build-depends" ("bar, baz"))))) + #t) + (x (pk 'fail x #f)))) + (define test-cabal-import "name: foo version: 1.0.0