import: hackage: Parse braced properties.

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 (read-braced-value): New procedure.
(is-property): Remove.
(is-layout-property, is-braced-property): New variables.
(lex-property): Rename to...
(lex-layout-property): ... this.
(lex-braced-property, lex-property): New procedures.
(lex-token): Add call to 'lex-property'.
* guix/tests/hackage.scm: Test braced description import.
* tests/hackage.scm (test-cabal-multiline-desc): Rename to...
(test-cabal-multiline-layout): ... this.
("hackage->guix-package test multiline desc"): Rename to...
("hackage->guix-package test multiline desc (layout)"): ... this.
(test-cabal-multiline-braced): New variable.
("hackage->guix-package test multiline desc (braced)"): New test.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Robert Vollmert 2019-06-02 00:27:50 +02:00 committed by Ludovic Courtès
parent 64d3181357
commit 959c9d159d
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 50 additions and 10 deletions

View file

@ -270,6 +270,10 @@ (define* (read-value port value min-indent #:optional (separator " "))
(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 @@ (define* (make-rx-matcher pat #:optional (flag #f))
(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 @@ (define* (read-while is? port #:optional
(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 @@ (define (lex-line port loc)
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 @@ (define (lex-line port loc)
((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

View file

@ -237,7 +237,7 @@ (define-package-matcher match-ghc-foo-6
(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 @@ (define test-cabal-multiline-desc
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)