[bug#35846] [PATCH] guix/import/cabal: handle braced descriptions (fixes #35735)

[bug#35846] [PATCH] guix/import/cabal: handle braced descriptions (fixes #35735)

[Robert Vollmert]

[-- Attachment #1: Type: text/plain, Size: 321 bytes --]

This fixes the cabal importer to deal with braced instead of layouted
properties. This is based on the current approach of lexing a whole
property as a token; it feels not ideal, but I’m not fluent enough in
guile (or the cabal format) to do better.

Compare https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35735


[-- Attachment #2: 0001-guix-import-cabal-parse-braced-description-propertie.patch --]
[-- Type: application/octet-stream, Size: 5197 bytes --]

From 801181aab72d9a373de7658f3b201c5735708849 Mon Sep 17 00:00:00 2001
From: Robert Vollmert <rob@vllmrt.net>
Date: Fri, 17 May 2019 14:26:36 +0200
Subject: [PATCH] guix: import: cabal: parse braced description properties

* guix/import/cabal.scm: generalize property bracing to both
                         layouted and simple braced blocks
* guix/tests/hackage.scm: test braced description import
---
 guix/import/cabal.scm | 37 ++++++++++++++++++++++++++++++-------
 tests/hackage.scm     | 20 ++++++++++++++++++++
 2 files changed, 50 insertions(+), 7 deletions(-)

diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 13c2f3f48c..383702f2be 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -270,6 +270,12 @@ following lines with indentation larger than MIN-INDENT."
                 (peek-next-line-indent port)))
         val)))
 
+(define* (read-braced-value port)
+  "Read up to a closing brace."
+  (begin
+     (display "reading braced value\n")
+     (string-trim-both (read-delimited "}" port 'trim))))
+
 (define (lex-white-space port bol)
   "Consume white spaces and comment lines on PORT.  If a new line is started return #t,
 otherwise return BOL (beginning-of-line)."
@@ -343,8 +349,11 @@ matching a string against the created regexp."
                 (make-regexp pat))))
     (cut regexp-exec rx <>)))
 
-(define is-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ \t]*(\\w?.*)$"
-                                     regexp/icase))
+(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]*$"
+                                            regexp/icase))
 
 (define is-flag (make-rx-matcher "^flag +([a-z0-9_-]+)"
                                  regexp/icase))
@@ -435,13 +444,19 @@ string with the read characters."
                  (begin (unread-char c) (list->string res)))))
           (else (list->string res)))))
 
-(define (lex-property k-v-rx-res loc port)
+(define (lex-layout-property k-v-rx-res loc port)
   (let ((key (string-downcase (match:substring k-v-rx-res 1)))
         (value (match:substring k-v-rx-res 2)))
     (make-lexical-token
      'PROPERTY loc
      (list key `(,(read-value port value (current-indentation)))))))
 
+(define (lex-braced-property k-rx-res loc port)
+  (let ((key (string-downcase (match:substring k-rx-res 1))))
+    (make-lexical-token
+     'PROPERTY loc
+     (list key `(,(read-braced-value port))))))
+
 (define (lex-rx-res rx-res token loc)
   (let ((name (string-downcase (match:substring rx-res 1))))
     (make-lexical-token token loc name)))
@@ -552,7 +567,6 @@ LOC is the current port location."
 the current port location."
   (let* ((s (read-delimited "\n{}" port 'peek)))
     (cond
-     ((is-property s) => (cut lex-property <> loc port))
      ((is-flag s) => (cut lex-flag <> loc))
      ((is-src-repo s) => (cut lex-src-repo <> loc))
      ((is-exec s) => (cut lex-exec <> loc))
@@ -561,13 +575,22 @@ the current port location."
      ((is-benchmark s) => (cut lex-benchmark <> loc))
      ((is-lib s) (lex-lib loc))
      ((is-else s) (lex-else loc))
-     (else
-      #f))))
+     (else (unread-string s port) #f))))
+
+(define (lex-property port loc)
+  (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))
+      (else #f))))
 
 (define (lex-token port)
   (let* ((loc (make-source-location (cabal-file-name) (port-line port)
                                     (port-column port) -1 -1)))
-    (or (lex-single-char port loc) (lex-word port loc) (lex-line port loc))))
+    (or (lex-single-char port loc)
+        (lex-word port loc)
+        (lex-line port loc)
+        (lex-property port loc))))
 
 ;; Lexer- and error-function generators
 
diff --git a/tests/hackage.scm b/tests/hackage.scm
index e56aa996d6..772ecd5217 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -128,6 +128,22 @@ library
       mtl        >= 2.0      && < 3
 ")
 
+;; Check braces instead of layout
+(define test-cabal-7
+  "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: {
+description
+}
+license: BSD3
+executable cabal
+  build-depends:
+    HTTP       >= 4000.2.5 && < 4000.3,
+    mtl        >= 2.0      && < 3
+")
+
 ;; A fragment of a real Cabal file with minor modification to check precedence
 ;; of 'and' over 'or', missing final newline, spaces between keywords and
 ;; parentheses and between key and column.
@@ -243,6 +259,10 @@ library
      (x
       (pk 'fail x #f)))))
 
+(test-assert "hackage->guix-package test 7"
+  (eval-test-with-cabal test-cabal-7
+                        #:cabal-environment '(("impl" . "ghc-7.8"))))
+
 (test-assert "read-cabal test 1"
   (match (call-with-input-string test-read-cabal-1 read-cabal)
     ((("name" ("test-me"))
-- 
2.21.0

[bug#35846] [PATCH] revised: guix/import/cabal: handle braced descriptions (fixes #35735)

[Robert Vollmert]

[-- Attachment #1: Type: text/plain, Size: 61 bytes --]

There was a stray debug print left in the previous version.


[-- Attachment #2: 0001-guix-import-cabal-parse-braced-description-propertie.patch --]
[-- Type: application/octet-stream, Size: 5138 bytes --]

From 35c2a4740c6f19ca4f0146ef274fb7806fcb72b7 Mon Sep 17 00:00:00 2001
From: Robert Vollmert <rob@vllmrt.net>
Date: Fri, 17 May 2019 14:26:36 +0200
Subject: [PATCH] guix: import: cabal: parse braced description properties

* guix/import/cabal.scm: generalize property bracing to both
                         layouted and simple braced blocks
* guix/tests/hackage.scm: test braced description import
---
 guix/import/cabal.scm | 35 ++++++++++++++++++++++++++++-------
 tests/hackage.scm     | 20 ++++++++++++++++++++
 2 files changed, 48 insertions(+), 7 deletions(-)

diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 13c2f3f48c..3028ed2882 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -270,6 +270,10 @@ following lines with indentation larger than MIN-INDENT."
                 (peek-next-line-indent port)))
         val)))
 
+(define* (read-braced-value port)
+  "Read up to a closing brace."
+  (string-trim-both (read-delimited "}" port 'trim)))
+
 (define (lex-white-space port bol)
   "Consume white spaces and comment lines on PORT.  If a new line is started return #t,
 otherwise return BOL (beginning-of-line)."
@@ -343,8 +347,11 @@ matching a string against the created regexp."
                 (make-regexp pat))))
     (cut regexp-exec rx <>)))
 
-(define is-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ \t]*(\\w?.*)$"
-                                     regexp/icase))
+(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]*$"
+                                            regexp/icase))
 
 (define is-flag (make-rx-matcher "^flag +([a-z0-9_-]+)"
                                  regexp/icase))
@@ -435,13 +442,19 @@ string with the read characters."
                  (begin (unread-char c) (list->string res)))))
           (else (list->string res)))))
 
-(define (lex-property k-v-rx-res loc port)
+(define (lex-layout-property k-v-rx-res loc port)
   (let ((key (string-downcase (match:substring k-v-rx-res 1)))
         (value (match:substring k-v-rx-res 2)))
     (make-lexical-token
      'PROPERTY loc
      (list key `(,(read-value port value (current-indentation)))))))
 
+(define (lex-braced-property k-rx-res loc port)
+  (let ((key (string-downcase (match:substring k-rx-res 1))))
+    (make-lexical-token
+     'PROPERTY loc
+     (list key `(,(read-braced-value port))))))
+
 (define (lex-rx-res rx-res token loc)
   (let ((name (string-downcase (match:substring rx-res 1))))
     (make-lexical-token token loc name)))
@@ -552,7 +565,6 @@ LOC is the current port location."
 the current port location."
   (let* ((s (read-delimited "\n{}" port 'peek)))
     (cond
-     ((is-property s) => (cut lex-property <> loc port))
      ((is-flag s) => (cut lex-flag <> loc))
      ((is-src-repo s) => (cut lex-src-repo <> loc))
      ((is-exec s) => (cut lex-exec <> loc))
@@ -561,13 +573,22 @@ the current port location."
      ((is-benchmark s) => (cut lex-benchmark <> loc))
      ((is-lib s) (lex-lib loc))
      ((is-else s) (lex-else loc))
-     (else
-      #f))))
+     (else (unread-string s port) #f))))
+
+(define (lex-property port loc)
+  (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))
+      (else #f))))
 
 (define (lex-token port)
   (let* ((loc (make-source-location (cabal-file-name) (port-line port)
                                     (port-column port) -1 -1)))
-    (or (lex-single-char port loc) (lex-word port loc) (lex-line port loc))))
+    (or (lex-single-char port loc)
+        (lex-word port loc)
+        (lex-line port loc)
+        (lex-property port loc))))
 
 ;; Lexer- and error-function generators
 
diff --git a/tests/hackage.scm b/tests/hackage.scm
index e56aa996d6..772ecd5217 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -128,6 +128,22 @@ library
       mtl        >= 2.0      && < 3
 ")
 
+;; Check braces instead of layout
+(define test-cabal-7
+  "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: {
+description
+}
+license: BSD3
+executable cabal
+  build-depends:
+    HTTP       >= 4000.2.5 && < 4000.3,
+    mtl        >= 2.0      && < 3
+")
+
 ;; A fragment of a real Cabal file with minor modification to check precedence
 ;; of 'and' over 'or', missing final newline, spaces between keywords and
 ;; parentheses and between key and column.
@@ -243,6 +259,10 @@ library
      (x
       (pk 'fail x #f)))))
 
+(test-assert "hackage->guix-package test 7"
+  (eval-test-with-cabal test-cabal-7
+                        #:cabal-environment '(("impl" . "ghc-7.8"))))
+
 (test-assert "read-cabal test 1"
   (match (call-with-input-string test-read-cabal-1 read-cabal)
     ((("name" ("test-me"))
-- 
2.21.0