[PATCH] import: hackage: Support "common" field and imports

OpenSubmitted by Philip Munksgaard.
Details
2 participants
  • Ludovic Courtès
  • Philip Munksgaard
Owner
unassigned
Severity
normal
P
P
Philip Munksgaard wrote 4 days ago
(address . guix-patches@gnu.org)(name . Philip Munksgaard)(address . philip@munksgaard.me)
20210610083953.664318-1-philip@munksgaard.me
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.--- guix/import/cabal.scm | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-)
Toggle diff (97 lines)diff --git a/guix/import/cabal.scm b/guix/import/cabal.scmindex da00019297..22b5d164d0 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 (cut match <>+ (('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-- 2.31.1
L
L
Ludovic Courtès wrote 9 hours ago
(name . Philip Munksgaard)(address . philip@munksgaard.me)(address . 48943@debbugs.gnu.org)
87wnqxzeop.fsf@gnu.org
Hi,
Philip Munksgaard <philip@munksgaard.me> skribis:
Toggle quote (8 lines)> 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.
Could you add a test case in ‘tests/hackage.scm’ and send an updatedpatch?
Apart from that it LGTM, thanks!
Ludo’.
?