mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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
2 changed files with 50 additions and 10 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue