GNU bug report logs - #48943
[PATCH] import: hackage: Support "common" field and imports

Previous Next

Package: guix-patches;

Reported by: Philip Munksgaard <philip <at> munksgaard.me>

Date: Thu, 10 Jun 2021 08:41:02 UTC

Severity: normal

Tags: patch

Done: Ludovic Courtès <ludo <at> gnu.org>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 48943 in the body.
You can then email your comments to 48943 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox

Report forwarded to guix-patches <at> gnu.org:
bug#48943; Package guix-patches. (Thu, 10 Jun 2021 08:41:02 GMT) Full text and rfc822 format available.
Acknowledgement sent to Philip Munksgaard <philip <at> munksgaard.me>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Thu, 10 Jun 2021 08:41:02 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Philip Munksgaard <philip <at> munksgaard.me>
To: guix-patches <at> gnu.org
Cc: Philip Munksgaard <philip <at> munksgaard.me>
Subject: [PATCH] import: hackage: Support "common" field and imports
Date: Thu, 10 Jun 2021 10:39:53 +0200

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(-)

diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 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
Information forwarded to guix-patches <at> gnu.org:
bug#48943; Package guix-patches. (Sun, 13 Jun 2021 20:35:01 GMT) Full text and rfc822 format available.

Message #8 received at 48943 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Philip Munksgaard <philip <at> munksgaard.me>
Cc: 48943 <at> debbugs.gnu.org
Subject: Re: bug#48943: [PATCH] import: hackage: Support "common" field and
 imports
Date: Sun, 13 Jun 2021 22:34:46 +0200

Hi,

Philip Munksgaard <philip <at> munksgaard.me> skribis:

> 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 updated
patch?

Apart from that it LGTM, thanks!

Ludo’.
Information forwarded to guix-patches <at> gnu.org:
bug#48943; Package guix-patches. (Fri, 18 Jun 2021 12:49:02 GMT) Full text and rfc822 format available.

Message #11 received at 48943 <at> debbugs.gnu.org (full text, mbox):

From: Philip Munksgaard <philip <at> munksgaard.me>
To: 48943 <at> debbugs.gnu.org
Cc: Philip Munksgaard <philip <at> munksgaard.me>
Subject: [PATCH v2] import: hackage: Support "common" field and imports
Date: Fri, 18 Jun 2021 14:48:13 +0200

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.
---
 guix/import/cabal.scm | 27 +++++++++++++++++++++++++--
 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..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
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")
-- 
2.31.1
Reply sent to Ludovic Courtès <ludo <at> gnu.org>:
You have taken responsibility. (Fri, 25 Jun 2021 12:28:14 GMT) Full text and rfc822 format available.
Notification sent to Philip Munksgaard <philip <at> munksgaard.me>:
bug acknowledged by developer. (Fri, 25 Jun 2021 12:28:15 GMT) Full text and rfc822 format available.

Message #16 received at 48943-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Philip Munksgaard <philip <at> munksgaard.me>
Cc: 48943-done <at> debbugs.gnu.org
Subject: Re: bug#48943: [PATCH] import: hackage: Support "common" field and
 imports
Date: Fri, 25 Jun 2021 14:27:35 +0200

[Message part 1 (text/plain, inline)]
Hi,

Philip Munksgaard <philip <at> munksgaard.me> skribis:

> 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.

Applied with the change below (‘cut’ is for procedures but ‘match’ is a
macro).

Thanks!

Ludo’.


[Message part 2 (text/x-patch, inline)]
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 22b5d164d0..e9a0179b3d 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -809,10 +809,10 @@ the ordering operation and the version."
       (if (eq? value 'false) #f #t)))
 
   (define common-stanzas
-    (filter-map (cut match <>
-                   (('section 'common common-name common)
-                    (cons common-name common))
-                   (_ #f))
+    (filter-map (match-lambda
+                  (('section 'common common-name common)
+                   (cons common-name common))
+                  (_ #f))
                 cabal-sexp))
 
   (define (eval sexp)
bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Sat, 24 Jul 2021 11:24:06 GMT) Full text and rfc822 format available.
This bug report was last modified 2 years and 276 days ago.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.