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

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guix-patches; Reported by: Philip Munksgaard <philip@HIDDEN>; Keywords: patch; dated Thu, 10 Jun 2021 08:41:02 UTC; Maintainer for guix-patches is guix-patches@HIDDEN.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 10 Jun 2021 08:40:10 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Thu Jun 10 04:40:10 2021
Received: from localhost ([127.0.0.1]:35458 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1lrGER-000189-8f
	for submit <at> debbugs.gnu.org; Thu, 10 Jun 2021 04:40:10 -0400
Received: from lists.gnu.org ([209.51.188.17]:49788)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <philip@HIDDEN>) id 1lrGEO-00017y-ER
 for submit <at> debbugs.gnu.org; Thu, 10 Jun 2021 04:40:05 -0400
Received: from eggs.gnu.org ([2001:470:142:3::10]:49456)
 by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <philip@HIDDEN>)
 id 1lrGEN-0003L8-EZ
 for guix-patches@HIDDEN; Thu, 10 Jun 2021 04:40:04 -0400
Received: from wout4-smtp.messagingengine.com ([64.147.123.20]:39073)
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <philip@HIDDEN>)
 id 1lrGEL-0004rT-2M
 for guix-patches@HIDDEN; Thu, 10 Jun 2021 04:40:03 -0400
Received: from compute4.internal (compute4.nyi.internal [10.202.2.44])
 by mailout.west.internal (Postfix) with ESMTP id 1E01323AA;
 Thu, 10 Jun 2021 04:39:57 -0400 (EDT)
Received: from mailfrontend2 ([10.202.2.163])
 by compute4.internal (MEProxy); Thu, 10 Jun 2021 04:39:57 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=munksgaard.me;
 h=from:to:cc:subject:date:message-id:mime-version
 :content-transfer-encoding; s=fm1; bh=fWxxxNzpitI2voLccz4LZT1sCa
 WWVUvr+Nl+B8eF5r4=; b=XWyAsa1CIs20yqHm1l235WI4ZVAJIRjNoPZNWfsoWH
 l2oNHb6/dg8u3XFgLz1ur02JAeXMgx0XqBrCYO/EEa7Qio2d72TrC2IveZ9V1pel
 MVDZtwaNI25SKOotvP1jmr9Est+I0fYUYr1jnfFNvIhRhAdObGBJiebYyZHVRHEk
 9AlcIJBM3D3CxRrHvxKck2yHFqkekHp34Ptf1UTIeSJuwrBatB9H5MMRir31X55x
 VsGbwgnnAlvG050d4P+gFHVozR1BmOKSrgabc6DBDf8/uXzlPr7PqI3+zsHl9j+i
 wBjxwV/dkW5VHeyisZiNN5JZRRMBZT55X/cmt8WuUSzg==
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=
 messagingengine.com; h=cc:content-transfer-encoding:date:from
 :message-id:mime-version:subject:to:x-me-proxy:x-me-proxy
 :x-me-sender:x-me-sender:x-sasl-enc; s=fm3; bh=fWxxxNzpitI2voLcc
 z4LZT1sCaWWVUvr+Nl+B8eF5r4=; b=neDSyKh4gWkziwwZom9UpjREQ1jCxsvoL
 Xdvgkf1JTCdGAAYQ+kcHwd0spQ2BgM6kH4KLt5bsLrEovXOJeaRSHUaDqJHX6kx+
 TFqN3M5feiZHpyqmDsM/sIVSKZjsBot1E6feTOnwGMXjklVhAnHef5TQ8ZNjE1PQ
 8cl65Qry5p+v4KMlJQ8v+5oWSe6htPM47a8hVvQdr7FGzo9m7Fmf88QTsfrEKDn9
 LgfeJOEQL40zPjUxs6Q3gl1g0C852pXvXoLewn/bOXzUHVHznSuApGE68OcWBbh0
 a3RTwQQO0bTHn0Ge+QczMS/T8+et/m4td22WvXEQFalyp8JHKs2eg==
X-ME-Sender: <xms:3M_BYIlSuyE2DtWJZzQj3ClRKvjyknqvwWEGe1-DavBghPpTy3tpcQ>
 <xme:3M_BYH1WK9XdEZHdewwp-ehvatq7kJYXaWVPfnLh8gY_3webIUs6yUv1zYV7f5rQy
 PX9HUjw78SF_At_MPg>
X-ME-Received: <xmr:3M_BYGp5xMvBqI7wm6P2vq9Ukh2uEvxTWxkphjxzzbr6AhKS6LpqJK7tMQKLXmTjrfwC9Evcc50tjI7HPB1x9Eg>
X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgeduledrfedufedgtdehucetufdoteggodetrfdotf
 fvucfrrhhofhhilhgvmecuhfgrshhtofgrihhlpdfqfgfvpdfurfetoffkrfgpnffqhgen
 uceurghilhhouhhtmecufedttdenucenucfjughrpefhvffufffkofgggfestdekredtre
 dttdenucfhrhhomheprfhhihhlihhpucfouhhnkhhsghgrrghrugcuoehphhhilhhiphes
 mhhunhhkshhgrggrrhgurdhmvgeqnecuggftrfgrthhtvghrnhepjedtjeduudevfeffve
 ejgedtgeeutedutedvteekteffgfffffffgfeuffetgefhnecuffhomhgrihhnpehgnhhu
 rdhorhhgnecuvehluhhsthgvrhfuihiivgeptdenucfrrghrrghmpehmrghilhhfrhhomh
 epphhhihhlihhpsehmuhhnkhhsghgrrghrugdrmhgv
X-ME-Proxy: <xmx:3M_BYElaWGZ9fFPlG6V9CPepiBnvwUFjq-Kha9eNePT9vLQFJHZL1g>
 <xmx:3M_BYG3LS7qjGEhAmVS2xZxrMo9EfnklN7uE5zTM3UC_eAdRKDtjQQ>
 <xmx:3M_BYLsnbPpuowzhDVuHf2PoNP1n3GCOEdi06cAI3MyCpYUMQiqNUg>
 <xmx:3M_BYL-ZW9ZMPBg1MdSSI3yi-E55M6SwrCSILMAaI-Zu-EEwLLcB5A>
Received: by mail.messagingengine.com (Postfix) with ESMTPA; Thu,
 10 Jun 2021 04:39:55 -0400 (EDT)
From: Philip Munksgaard <philip@HIDDEN>
To: guix-patches@HIDDEN
Subject: [PATCH] import: hackage: Support "common" field and imports
Date: Thu, 10 Jun 2021 10:39:53 +0200
Message-Id: <20210610083953.664318-1-philip@HIDDEN>
X-Mailer: git-send-email 2.31.1
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
Received-SPF: pass client-ip=64.147.123.20; envelope-from=philip@HIDDEN;
 helo=wout4-smtp.messagingengine.com
X-Spam_score_int: -27
X-Spam_score: -2.8
X-Spam_bar: --
X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
 DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1,
 RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H4=0.001, RCVD_IN_MSPIKE_WL=0.001,
 SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: -1.6 (-)
X-Debbugs-Envelope-To: submit
Cc: Philip Munksgaard <philip@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.6 (--)

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





Acknowledgement sent to Philip Munksgaard <philip@HIDDEN>:
New bug report received and forwarded. Copy sent to guix-patches@HIDDEN. Full text available.
Report forwarded to guix-patches@HIDDEN:
bug#48943; Package guix-patches. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Thu, 10 Jun 2021 08:45:01 UTC

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