futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

import: cabal: Support elif statement.

Browse Source 
Fixes <https://issues.guix.gnu.org/54752>.

* guix/import/cabal.scm (make-cabal-parser): Replace if-then-else grammar case with elif-else, modify if-then accordingly.
(is-elif): New procedure.
(lex-elif): Likewise.
(is-id): Add elif keyword.
(lex-word): Add test for elif.
* tests/hackage.scm (test-cabal-if): New variale.
(test-cabal-else): Likewise.
(test-cabal-elif): Likewise.
(test-cabal-elif-brackets): Likewise.
(match-ghc-elif): Likewise.
("hackage->guix-package test lonely if statement",
"hackage->guix-package test else statement",
"hackage->guix-package test elif statement",
"hackage->guix-package test elif statement with brackets"): New tests.
This commit is contained in:
Lars-Dominik Braun 2022-04-30 15:38:44 +02:00
parent 0c6123f8aa
commit 2c5d18e421
No known key found for this signature in database
GPG Key ID: F663943E08D8092A
2 changed files with 136 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
guix/import/cabal.scm
View File

@ -149,7 +149,7 @@ to the stack."
(right: IF FLAG EXEC TEST-SUITE CUSTOM-SETUP SOURCE-REPO BENCHMARK LIB COMMON OCURLY)
(left: OR)
(left: PROPERTY AND)
(right: ELSE NOT))
(right: ELIF ELSE NOT))
;; --- rules
(body (properties sections) : (append $1 $2))
(sections (sections flags) : (append $1 $2)
@ -193,32 +193,32 @@ to the stack."
(LIB open exprs close) : `(section library ,$3))
(exprs (exprs PROPERTY) : (append $1 (list $2))
(PROPERTY) : (list $1)
(exprs if-then-else) : (append $1 (list $2))
(if-then-else) : (list $1)
(exprs if-then) : (append $1 (list $2))
(if-then) : (list $1))
(if-then-else (IF tests OCURLY exprs CCURLY ELSE OCURLY exprs CCURLY)
: `(if ,$2 ,$4 ,$8)
(IF tests open exprs close ELSE OCURLY exprs CCURLY)
: `(if ,$2 ,$4 ,$8)
;; The 'open' token after 'tests' is shifted after an 'exprs'
;; is found. This is because, instead of 'exprs' a 'OCURLY'
;; token is a valid alternative. For this reason, 'open'
;; pushes a <parse-context> with a line indentation equal to
;; the indentation of 'exprs'.
;;
;; Differently from this, without the rule above this
;; comment, when an 'ELSE' token is found, the 'open' token
;; following the 'ELSE' would be shifted immediately, before
;; the 'exprs' is found (because there are no other valid
;; tokens). The 'open' would therefore create a
;; <parse-context> with the indentation of 'ELSE' and not
;; 'exprs', creating an inconsistency. We therefore allow
;; mixed style conditionals.
(IF tests open exprs close ELSE open exprs close)
: `(if ,$2 ,$4 ,$8))
(if-then (IF tests OCURLY exprs CCURLY) : `(if ,$2 ,$4 ())
(IF tests open exprs close) : `(if ,$2 ,$4 ()))
(exprs elif-else) : (append $1 (list ($2 '(()))))
(elif-else) : (list ($1 '(()))))
;; LALR(1) parsers prefer to be left-recursive, which make if-statements slightly involved.
;; XXX: This technically allows multiple else statements.
(elif-else (elif-else ELIF tests OCURLY exprs CCURLY) : (lambda (y) ($1 (list (append (list 'if $3 $5) y))))
(elif-else ELIF tests open exprs close) : (lambda (y) ($1 (list (append (list 'if $3 $5) y))))
(elif-else ELSE OCURLY exprs CCURLY) : (lambda (y) ($1 (list $4)))
;; The 'open' token after 'tests' is shifted after an 'exprs'
;; is found. This is because, instead of 'exprs' a 'OCURLY'
;; token is a valid alternative. For this reason, 'open'
;; pushes a <parse-context> with a line indentation equal to
;; the indentation of 'exprs'.
;;
;; Differently from this, without the rule above this
;; comment, when an 'ELSE' token is found, the 'open' token
;; following the 'ELSE' would be shifted immediately, before
;; the 'exprs' is found (because there are no other valid
;; tokens). The 'open' would therefore create a
;; <parse-context> with the indentation of 'ELSE' and not
;; 'exprs', creating an inconsistency. We therefore allow
;; mixed style conditionals.
(elif-else ELSE open exprs close) : (lambda (y) ($1 (list $4)))
;; Terminating rule.
(if-then) : (lambda (y) (append $1 y)))
(if-then (IF tests OCURLY exprs CCURLY) : (list 'if $2 $4)
(IF tests open exprs close) : (list 'if $2 $4))
(tests (TEST OPAREN ID CPAREN) : `(,$1 ,$3)
(TRUE) : 'true
(FALSE) : 'false
@ -386,6 +386,8 @@ matching a string against the created regexp."
(define is-else (make-rx-matcher "^else" regexp/icase))
(define (is-elif s) (string-ci=? s "elif"))
(define (is-if s) (string-ci=? s "if"))
(define (is-true s) (string-ci=? s "true"))
@ -402,8 +404,8 @@ matching a string against the created regexp."
(define (is-id s port loc)
(let ((cabal-reserved-words
'("if" "else" "library" "flag" "executable" "test-suite" "custom-setup"
"source-repository" "benchmark" "common"))
'("if" "else" "elif" "library" "flag" "executable" "test-suite"
"custom-setup" "source-repository" "benchmark" "common"))
(spaces (read-while (cut char-set-contains? char-set:blank <>) port))
(c (peek-char port)))
(unread-string spaces port)
@ -494,6 +496,8 @@ string with the read characters."
(define (lex-else loc) (make-lexical-token 'ELSE loc #f))
(define (lex-elif loc) (make-lexical-token 'ELIF loc #f))
(define (lex-if loc) (make-lexical-token 'IF loc #f))
(define (lex-true loc) (make-lexical-token 'TRUE loc #t))
@ -568,6 +572,7 @@ location."
LOC is the current port location."
(let* ((w (read-delimited " <>=()\t\n" port 'peek)))
(cond ((is-if w) (lex-if loc))
((is-elif w) (lex-elif loc))
((is-test w port) (lex-test w loc))
((is-true w) (lex-true loc))
((is-false w) (lex-false loc))

102
tests/hackage.scm
View File

@ -309,6 +309,108 @@ executable cabal
(test-assert "hackage->guix-package test flag executable"
(eval-test-with-cabal test-cabal-flag-executable match-ghc-foo))
;; Check if-elif-else statements
(define test-cabal-if
"name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
if os(first)
Build-depends: ghc-c
")
(define test-cabal-else
"name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
if os(first)
Build-depends: ghc-a
else
Build-depends: ghc-c
")
(define test-cabal-elif
"name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
if os(first)
Build-depends: ghc-a
elif os(second)
Build-depends: ghc-b
elif os(guix)
Build-depends: ghc-c
elif os(third)
Build-depends: ghc-d
else
Build-depends: ghc-e
")
;; Try the same with different bracket styles
(define test-cabal-elif-brackets
"name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
if os(first) {
Build-depends: ghc-a
}
elif os(second)
Build-depends: ghc-b
elif os(guix) { Build-depends: ghc-c }
elif os(third) {
Build-depends: ghc-d }
else
Build-depends: ghc-e
")
(define-package-matcher match-ghc-elif
('package
('name "ghc-foo")
('version "1.0.0")
('source
('origin
('method 'url-fetch)
('uri ('hackage-uri "foo" 'version))
('sha256
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
('inputs ('list 'ghc-c))
('home-page "http://test.org")
('synopsis (? string?))
('description (? string?))
('license 'license:bsd-3)))
(test-assert "hackage->guix-package test lonely if statement"
(eval-test-with-cabal test-cabal-else match-ghc-elif
#:cabal-environment '(("os" . "guix"))))
(test-assert "hackage->guix-package test else statement"
(eval-test-with-cabal test-cabal-else match-ghc-elif
#:cabal-environment '(("os" . "guix"))))
(test-assert "hackage->guix-package test elif statement"
(eval-test-with-cabal test-cabal-elif match-ghc-elif
#:cabal-environment '(("os" . "guix"))))
(test-assert "hackage->guix-package test elif statement with brackets"
(eval-test-with-cabal test-cabal-elif-brackets match-ghc-elif
#:cabal-environment '(("os" . "guix"))))
;; Check Hackage Cabal revisions.
(define test-cabal-revision
"name: foo