* [bug#36046] [PATCH 2/2] guix import hackage: Parse braced properties.
2019-06-01 22:27 [bug#36047] [PATCH 1/2] tests: hackage: Test multiline cabal description Robert Vollmert
@ 2019-06-01 22:27 ` Robert Vollmert
2019-06-02 20:15 ` bug#36047: [PATCH 1/2] tests: hackage: Test multiline cabal description Ludovic Courtès
1 sibling, 0 replies; 3+ messages in thread
From: Robert Vollmert @ 2019-06-01 22:27 UTC (permalink / raw)
To: 36046; +Cc: Robert Vollmert
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)
^ permalink raw reply related [flat|nested] 3+ messages in thread