ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: hackage: Make parsing of tests and fields more flexible.

Browse source 
* guix/import/cabal.scm (is-test): Allow spaces between keyword and
  parentheses.
  (is-id): Add argument 'port'.  Allow spaces between keyword and column.
  (lex-word): Adjust call to 'is-id'.
This commit is contained in:
Federico Beffa 2015-11-11 16:20:45 +01:00
parent 876fd23ab6
commit 94abc84887
1 changed files with 13 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/import/cabal.scm
View file

@ -333,7 +333,7 @@ (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]*(\\w?.*)$"
(define is-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ \t]*(\\w?.*)$"
regexp/icase))
(define is-flag (make-rx-matcher "^flag +([a-z0-9_-]+)"
@ -366,17 +366,24 @@ (define (is-and s) (string=? s "&&"))
(define (is-or s) (string=? s "||"))
(define (is-id s)
(define (is-id s port)
(let ((cabal-reserved-words
'("if" "else" "library" "flag" "executable" "test-suite"
"source-repository" "benchmark")))
"source-repository" "benchmark"))
(spaces (read-while (cut char-set-contains? char-set:blank <>) port))
(c (peek-char port)))
(unread-string spaces port)
(and (every (cut string-ci<> s <>) cabal-reserved-words)
(not (char=? (last (string->list s)) #\:)))))
(and (not (char=? (last (string->list s)) #\:))
(not (char=? #\: c))))))
(define (is-test s port)
(let ((tests-rx (make-regexp "os|arch|flag|impl"))
(spaces (read-while (cut char-set-contains? char-set:blank <>) port))
(c (peek-char port)))
(and (regexp-exec tests-rx s) (char=? #\( c))))
(if (and (regexp-exec tests-rx s) (char=? #\( c))
#t
(begin (unread-string spaces port) #f))))
;; Lexers for individual tokens.
@ -509,7 +516,7 @@ (define (lex-word port loc)
((is-false w) (lex-false loc))
((is-and w) (lex-and loc))
((is-or w) (lex-or loc))
((is-id w) (lex-id w loc))
((is-id w port) (lex-id w loc))
(else (unread-string w port) #f))))
(define (lex-line port loc)