all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Philip Munksgaard <philip@munksgaard.me>
To: 48943@debbugs.gnu.org
Cc: Philip Munksgaard <philip@munksgaard.me>
Subject: [bug#48943] [PATCH] import: hackage: Support "common" field and imports
Date: Thu, 10 Jun 2021 10:39:53 +0200	[thread overview]
Message-ID: <20210610083953.664318-1-philip@munksgaard.me> (raw)

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





             reply	other threads:[~2021-06-10 13:08 UTC|newest]

Thread overview: 4+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-06-10  8:39 Philip Munksgaard [this message]
2021-06-13 20:34 ` [bug#48943] [PATCH] import: hackage: Support "common" field and imports Ludovic Courtès
2021-06-18 12:48 ` [bug#48943] [PATCH v2] " Philip Munksgaard
2021-06-25 12:27   ` bug#48943: [PATCH] " Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20210610083953.664318-1-philip@munksgaard.me \
    --to=philip@munksgaard.me \
    --cc=48943@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.