02/08: import: cabal: Allow curly brackets in more positions.

[guix-commits]

lbraun pushed a commit to branch master
in repository guix.

commit 0972feaff1f766c1759d0b89876132ae473725ce
Author: Lars-Dominik Braun <lars@6xq.net>
AuthorDate: Sat Apr 30 15:39:34 2022 +0200

    import: cabal: Allow curly brackets in more positions.
    
    * guix/import/cabal.scm (is-layout-property): Do not expect end of line.
    (lex-layout-property): Check for newline.
    (lex-property): Stop reading on closing curly bracket.
    * tests/hackage.scm (test-read-cabal-2): New variable.
    ("read-cabal test: if brackets on the same line"): New test.
---
 guix/import/cabal.scm | 11 ++++++++---
 tests/hackage.scm     | 16 ++++++++++++++++
 2 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index e1a082a31a..364fcc3176 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -354,7 +354,7 @@ matching a string against the created regexp."
                 (make-regexp pat))))
     (cut regexp-exec rx <>)))
 
-(define is-layout-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ 
\t]*(\\w?[^{}]*)$"
+(define is-layout-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ 
\t]*(\\w?[^{}]*)"
                                             regexp/icase))
 
 (define is-braced-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ \t]*\\{[ 
\t]*$"
@@ -465,7 +465,10 @@ string with the read characters."
         (value (match:substring k-v-rx-res 2)))
     (make-lexical-token
      'PROPERTY loc
-     (list key `(,(read-value port value (current-indentation)))))))
+     (list key `(,(if (eqv? (peek-char port) #\newline) ; The next character
+                      ; is not necessarily a newline if a bracket follows the 
property.
+                      (read-value port value (current-indentation))
+                      value))))))
 
 (define (lex-braced-property k-rx-res loc port)
   (let ((key (string-downcase (match:substring k-rx-res 1))))
@@ -600,7 +603,9 @@ the current port location."
      (else (unread-string s port) #f))))
 
 (define (lex-property port loc)
-  (let* ((s (read-delimited "\n" port 'peek)))
+  ;; Stop reading on a }, so closing brackets (for example during
+  ;; if-clauses) work properly.
+  (let* ((s (read-delimited "\n}" port 'peek)))
     (cond
       ((is-braced-property s) => (cut lex-braced-property <> loc port))
       ((is-layout-property s) => (cut lex-layout-property <> loc port))
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 38f75b268e..15309a3381 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -156,6 +156,12 @@ library
   Exposed-Modules:
     Test.QuickCheck.Exception")
 
+(define test-read-cabal-2
+  "name: test-me
+common defaults
+    if os(foobar) { cc-options: -DBARBAZ }
+") ; Intentional newline.
+
 (test-begin "hackage")
 
 (define-syntax-rule (define-package-matcher name pattern)
@@ -471,6 +477,16 @@ executable cabal
      #t)
     (x (pk 'fail x #f))))
 
+(test-assert "read-cabal test: if brackets on the same line"
+  (match (call-with-input-string test-read-cabal-2 read-cabal)
+    ((("name" ("test-me"))
+        ('section 'common "defaults"
+          (('if ('os "foobar")
+               (("cc-options" ("-DBARBAZ ")))
+               ()))))
+     #t)
+    (x (pk 'fail x #f))))
+
 (define test-cabal-import
   "name: foo
 version: 1.0.0