GNU bug report logs - #36046
[PATCH 2/2] guix import hackage: Parse braced properties.

Previous Next

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

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

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

From: Robert Vollmert <rob <at> vllmrt.net>
To: guix-patches <at> gnu.org
Cc: Robert Vollmert <rob <at> vllmrt.net>
Subject: [PATCH 2/2] guix import hackage: Parse braced properties.
Date: Sun,  2 Jun 2019 00:27:50 +0200

This adds partial support for cabal properties that use curly
braces instead of the layout rule. See for example
https://hackage.haskell.org/package/cassava/

* guix/import/cabal.scm: Generalize property parsing to both
layouted and simple braced blocks.
* guix/tests/hackage.scm: Test braced description import.
---
 guix/import/cabal.scm | 35 ++++++++++++++++++++++++++++-------
 tests/hackage.scm     | 25 ++++++++++++++++++++++---
 2 files changed, 50 insertions(+), 10 deletions(-)

diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 13c2f3f48c..1a87be0b00 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 2f45194fab..38a5825af7 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -237,7 +237,7 @@ library
   (eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
 
 ;; Check multi-line layouted description
-(define test-cabal-multiline-desc
+(define test-cabal-multiline-layout
   "name: foo
 version: 1.0.0
 homepage: http://test.org
@@ -251,9 +251,28 @@ executable cabal
     mtl        >= 2.0      && < 3
 ")
 
-(test-assert "hackage->guix-package test multiline desc"
-  (eval-test-with-cabal test-cabal-multiline-desc match-ghc-foo))
+(test-assert "hackage->guix-package test multiline desc (layout)"
+  (eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo))
 
+;; Check multi-line braced description
+(define test-cabal-multiline-braced
+  "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: {
+first line
+second line
+}
+license: BSD3
+executable cabal
+  build-depends:
+    HTTP       >= 4000.2.5 && < 4000.3,
+    mtl        >= 2.0      && < 3
+")
+
+(test-assert "hackage->guix-package test multiline desc (braced)"
+  (eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo))
 
 (test-assert "read-cabal test 1"
   (match (call-with-input-string test-read-cabal-1 read-cabal)
-- 
2.20.1 (Apple Git-117)

Previous Next

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