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:
parent
64d3181357
commit
959c9d159d
|
@ -270,6 +270,10 @@ following lines with indentation larger than MIN-INDENT."
|
||||||
(peek-next-line-indent port)))
|
(peek-next-line-indent port)))
|
||||||
val)))
|
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)
|
(define (lex-white-space port bol)
|
||||||
"Consume white spaces and comment lines on PORT. If a new line is started return #t,
|
"Consume white spaces and comment lines on PORT. If a new line is started return #t,
|
||||||
otherwise return BOL (beginning-of-line)."
|
otherwise return BOL (beginning-of-line)."
|
||||||
|
@ -343,8 +347,11 @@ matching a string against the created regexp."
|
||||||
(make-regexp pat))))
|
(make-regexp pat))))
|
||||||
(cut regexp-exec rx <>)))
|
(cut regexp-exec rx <>)))
|
||||||
|
|
||||||
(define is-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))
|
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_-]+)"
|
(define is-flag (make-rx-matcher "^flag +([a-z0-9_-]+)"
|
||||||
regexp/icase))
|
regexp/icase))
|
||||||
|
@ -435,13 +442,19 @@ string with the read characters."
|
||||||
(begin (unread-char c) (list->string res)))))
|
(begin (unread-char c) (list->string res)))))
|
||||||
(else (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)))
|
(let ((key (string-downcase (match:substring k-v-rx-res 1)))
|
||||||
(value (match:substring k-v-rx-res 2)))
|
(value (match:substring k-v-rx-res 2)))
|
||||||
(make-lexical-token
|
(make-lexical-token
|
||||||
'PROPERTY loc
|
'PROPERTY loc
|
||||||
(list key `(,(read-value port value (current-indentation)))))))
|
(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)
|
(define (lex-rx-res rx-res token loc)
|
||||||
(let ((name (string-downcase (match:substring rx-res 1))))
|
(let ((name (string-downcase (match:substring rx-res 1))))
|
||||||
(make-lexical-token token loc name)))
|
(make-lexical-token token loc name)))
|
||||||
|
@ -552,7 +565,6 @@ LOC is the current port location."
|
||||||
the current port location."
|
the current port location."
|
||||||
(let* ((s (read-delimited "\n{}" port 'peek)))
|
(let* ((s (read-delimited "\n{}" port 'peek)))
|
||||||
(cond
|
(cond
|
||||||
((is-property s) => (cut lex-property <> loc port))
|
|
||||||
((is-flag s) => (cut lex-flag <> loc))
|
((is-flag s) => (cut lex-flag <> loc))
|
||||||
((is-src-repo s) => (cut lex-src-repo <> loc))
|
((is-src-repo s) => (cut lex-src-repo <> loc))
|
||||||
((is-exec s) => (cut lex-exec <> loc))
|
((is-exec s) => (cut lex-exec <> loc))
|
||||||
|
@ -561,13 +573,22 @@ the current port location."
|
||||||
((is-benchmark s) => (cut lex-benchmark <> loc))
|
((is-benchmark s) => (cut lex-benchmark <> loc))
|
||||||
((is-lib s) (lex-lib loc))
|
((is-lib s) (lex-lib loc))
|
||||||
((is-else s) (lex-else loc))
|
((is-else s) (lex-else loc))
|
||||||
(else
|
(else (unread-string s port) #f))))
|
||||||
#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)
|
(define (lex-token port)
|
||||||
(let* ((loc (make-source-location (cabal-file-name) (port-line port)
|
(let* ((loc (make-source-location (cabal-file-name) (port-line port)
|
||||||
(port-column port) -1 -1)))
|
(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
|
;; Lexer- and error-function generators
|
||||||
|
|
||||||
|
|
|
@ -237,7 +237,7 @@ library
|
||||||
(eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
|
(eval-test-with-cabal test-cabal-6 match-ghc-foo-6))
|
||||||
|
|
||||||
;; Check multi-line layouted description
|
;; Check multi-line layouted description
|
||||||
(define test-cabal-multiline-desc
|
(define test-cabal-multiline-layout
|
||||||
"name: foo
|
"name: foo
|
||||||
version: 1.0.0
|
version: 1.0.0
|
||||||
homepage: http://test.org
|
homepage: http://test.org
|
||||||
|
@ -251,9 +251,28 @@ executable cabal
|
||||||
mtl >= 2.0 && < 3
|
mtl >= 2.0 && < 3
|
||||||
")
|
")
|
||||||
|
|
||||||
(test-assert "hackage->guix-package test multiline desc"
|
(test-assert "hackage->guix-package test multiline desc (layout)"
|
||||||
(eval-test-with-cabal test-cabal-multiline-desc match-ghc-foo))
|
(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"
|
(test-assert "read-cabal test 1"
|
||||||
(match (call-with-input-string test-read-cabal-1 read-cabal)
|
(match (call-with-input-string test-read-cabal-1 read-cabal)
|
||||||
|
|
Loading…
Reference in New Issue