From ad7466aafd7f166d0b6be5eb32dda1d3ee8a6445 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 26 May 2019 23:18:21 +0200 Subject: import: hackage: Fix Cabal test. * guix/import/hackage.scm (hackage->guix-package): Remove call to 'memoize'. (hackage->guix-package/m): New procedure. (hackage-recursive-import): Use it. * tests/hackage.scm ("hackage->guix-package test 6"): Adjust. Co-authored-by: Robert Vollmert --- tests/hackage.scm | 37 +++++++++++++++++++++++++++++++++++-- 1 file changed, 35 insertions(+), 2 deletions(-) (limited to 'tests/hackage.scm') diff --git a/tests/hackage.scm b/tests/hackage.scm index e17851a213..0efad0638d 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -207,8 +207,41 @@ library #:cabal-environment '(("impl" . "ghc-7.8")))) (test-assert "hackage->guix-package test 6" - (eval-test-with-cabal test-cabal-6 - #:cabal-environment '(("impl" . "ghc-7.8")))) + (mock + ((guix import hackage) hackage-fetch + (lambda (name-version) + (call-with-input-string test-cabal-6 + read-cabal))) + (match (hackage->guix-package "foo") + (('package + ('name "ghc-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "https://hackage.haskell.org/package/foo/foo-" + 'version + ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'haskell-build-system) + ('inputs + ('quasiquote + (("ghc-b" ('unquote 'ghc-b)) + ("ghc-http" ('unquote 'ghc-http)) + ("ghc-mtl" ('unquote 'ghc-mtl))))) + ('native-inputs + ('quasiquote + (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi))))) + ('home-page "http://test.org") + ('synopsis (? string?)) + ('description (? string?)) + ('license 'bsd-3)) + #t) + (x + (pk 'fail x #f))))) (test-assert "read-cabal test 1" (match (call-with-input-string test-read-cabal-1 read-cabal) -- cgit v1.2.3 From 55c98f3261b6ced2c38e060566e1eb952bd3e42b Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Fri, 31 May 2019 23:22:41 +0200 Subject: tests: hackage: Factor out package pattern. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/hackage.scm: Import result pattern matching via helper. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 133 +++++++++++++++++++++++++++--------------------------- 1 file changed, 66 insertions(+), 67 deletions(-) (limited to 'tests/hackage.scm') diff --git a/tests/hackage.scm b/tests/hackage.scm index 0efad0638d..41e3b2dcd3 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -155,93 +155,92 @@ library (test-begin "hackage") -(define* (eval-test-with-cabal test-cabal #:key (cabal-environment '())) +(define-syntax-rule (define-package-matcher name pattern) + (define* (name obj) + (match obj + (pattern #t) + (x (pk 'fail x #f))))) + +(define-package-matcher match-ghc-foo + ('package + ('name "ghc-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "https://hackage.haskell.org/package/foo/foo-" + 'version + ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'haskell-build-system) + ('inputs + ('quasiquote + (("ghc-http" ('unquote 'ghc-http)) + ("ghc-mtl" ('unquote 'ghc-mtl))))) + ('home-page "http://test.org") + ('synopsis (? string?)) + ('description (? string?)) + ('license 'bsd-3))) + +(define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '())) (mock ((guix import hackage) hackage-fetch (lambda (name-version) (call-with-input-string test-cabal read-cabal))) - (match (hackage->guix-package "foo" #:cabal-environment cabal-environment) - (('package - ('name "ghc-foo") - ('version "1.0.0") - ('source - ('origin - ('method 'url-fetch) - ('uri ('string-append - "https://hackage.haskell.org/package/foo/foo-" - 'version - ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'haskell-build-system) - ('inputs - ('quasiquote - (("ghc-http" ('unquote 'ghc-http)) - ("ghc-mtl" ('unquote 'ghc-mtl))))) - ('home-page "http://test.org") - ('synopsis (? string?)) - ('description (? string?)) - ('license 'bsd-3)) - #t) - (x - (pk 'fail x #f))))) + (matcher (hackage->guix-package "foo" #:cabal-environment cabal-environment)))) (test-assert "hackage->guix-package test 1" - (eval-test-with-cabal test-cabal-1)) + (eval-test-with-cabal test-cabal-1 match-ghc-foo)) (test-assert "hackage->guix-package test 2" - (eval-test-with-cabal test-cabal-2)) + (eval-test-with-cabal test-cabal-2 match-ghc-foo)) (test-assert "hackage->guix-package test 3" - (eval-test-with-cabal test-cabal-3 + (eval-test-with-cabal test-cabal-3 match-ghc-foo #:cabal-environment '(("impl" . "ghc-7.8")))) (test-assert "hackage->guix-package test 4" - (eval-test-with-cabal test-cabal-4 + (eval-test-with-cabal test-cabal-4 match-ghc-foo #:cabal-environment '(("impl" . "ghc-7.8")))) (test-assert "hackage->guix-package test 5" - (eval-test-with-cabal test-cabal-5 + (eval-test-with-cabal test-cabal-5 match-ghc-foo #:cabal-environment '(("impl" . "ghc-7.8")))) +(define-package-matcher match-ghc-foo-6 + ('package + ('name "ghc-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "https://hackage.haskell.org/package/foo/foo-" + 'version + ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'haskell-build-system) + ('inputs + ('quasiquote + (("ghc-b" ('unquote 'ghc-b)) + ("ghc-http" ('unquote 'ghc-http)) + ("ghc-mtl" ('unquote 'ghc-mtl))))) + ('native-inputs + ('quasiquote + (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi))))) + ('home-page "http://test.org") + ('synopsis (? string?)) + ('description (? string?)) + ('license 'bsd-3))) + (test-assert "hackage->guix-package test 6" - (mock - ((guix import hackage) hackage-fetch - (lambda (name-version) - (call-with-input-string test-cabal-6 - read-cabal))) - (match (hackage->guix-package "foo") - (('package - ('name "ghc-foo") - ('version "1.0.0") - ('source - ('origin - ('method 'url-fetch) - ('uri ('string-append - "https://hackage.haskell.org/package/foo/foo-" - 'version - ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'haskell-build-system) - ('inputs - ('quasiquote - (("ghc-b" ('unquote 'ghc-b)) - ("ghc-http" ('unquote 'ghc-http)) - ("ghc-mtl" ('unquote 'ghc-mtl))))) - ('native-inputs - ('quasiquote - (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi))))) - ('home-page "http://test.org") - ('synopsis (? string?)) - ('description (? string?)) - ('license 'bsd-3)) - #t) - (x - (pk 'fail x #f))))) + (eval-test-with-cabal test-cabal-6 match-ghc-foo-6)) (test-assert "read-cabal test 1" (match (call-with-input-string test-read-cabal-1 read-cabal) -- cgit v1.2.3 From 4110cde00560bd97cc8d83c34b80c52f37c680a2 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Fri, 31 May 2019 23:22:42 +0200 Subject: tests: hackage: Don't mock hackage-fetch. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/hackage.scm: Pass a string input port to tests instead of mocking hackage download. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) (limited to 'tests/hackage.scm') diff --git a/tests/hackage.scm b/tests/hackage.scm index 41e3b2dcd3..1b4800164e 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -186,12 +186,8 @@ library ('license 'bsd-3))) (define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '())) - (mock - ((guix import hackage) hackage-fetch - (lambda (name-version) - (call-with-input-string test-cabal - read-cabal))) - (matcher (hackage->guix-package "foo" #:cabal-environment cabal-environment)))) + (define port (open-input-string test-cabal)) + (matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment))) (test-assert "hackage->guix-package test 1" (eval-test-with-cabal test-cabal-1 match-ghc-foo)) -- cgit v1.2.3 From 0be465924c6f745618a73eea816aa15aba7c8d30 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Fri, 31 May 2019 23:22:43 +0200 Subject: tests: Indent hackage tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/hackage.scm: Reindent using etc/indent-code.el. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) (limited to 'tests/hackage.scm') diff --git a/tests/hackage.scm b/tests/hackage.scm index 1b4800164e..e5f3d6caed 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -242,19 +242,19 @@ library (match (call-with-input-string test-read-cabal-1 read-cabal) ((("name" ("test-me")) ('section 'library - (('if ('flag "base4point8") - (("build-depends" ("base >= 4.8 && < 5"))) - (('if ('flag "base4") - (("build-depends" ("base >= 4 && < 4.8"))) - (('if ('flag "base3") - (("build-depends" ("base >= 3 && < 4"))) - (("build-depends" ("base < 3")))))))) - ('if ('or ('flag "base4point8") - ('and ('flag "base4") ('flag "base3"))) - (("build-depends" ("random"))) - ()) - ("build-depends" ("containers")) - ("exposed-modules" ("Test.QuickCheck.Exception"))))) + (('if ('flag "base4point8") + (("build-depends" ("base >= 4.8 && < 5"))) + (('if ('flag "base4") + (("build-depends" ("base >= 4 && < 4.8"))) + (('if ('flag "base3") + (("build-depends" ("base >= 3 && < 4"))) + (("build-depends" ("base < 3")))))))) + ('if ('or ('flag "base4point8") + ('and ('flag "base4") ('flag "base3"))) + (("build-depends" ("random"))) + ()) + ("build-depends" ("containers")) + ("exposed-modules" ("Test.QuickCheck.Exception"))))) #t) (x (pk 'fail x #f)))) -- cgit v1.2.3 From ea35f5c599a2fe4d6ab2925b1030f64e8b21e195 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Sun, 2 Jun 2019 00:16:02 +0200 Subject: tests: Fix hackage tests. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is a followup to 1cc12357a65e4479c2f4735e915941382ef82d94. * tests/hackage.scm: ghc-mtl is no longer added as an input. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'tests/hackage.scm') diff --git a/tests/hackage.scm b/tests/hackage.scm index e5f3d6caed..269c1e1f9b 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -178,8 +178,7 @@ library ('build-system 'haskell-build-system) ('inputs ('quasiquote - (("ghc-http" ('unquote 'ghc-http)) - ("ghc-mtl" ('unquote 'ghc-mtl))))) + (("ghc-http" ('unquote 'ghc-http))))) ('home-page "http://test.org") ('synopsis (? string?)) ('description (? string?)) @@ -225,8 +224,7 @@ library ('inputs ('quasiquote (("ghc-b" ('unquote 'ghc-b)) - ("ghc-http" ('unquote 'ghc-http)) - ("ghc-mtl" ('unquote 'ghc-mtl))))) + ("ghc-http" ('unquote 'ghc-http))))) ('native-inputs ('quasiquote (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi))))) -- cgit v1.2.3 From 64d31813577b7471f819652e3ec81abb285bb77c Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Sun, 2 Jun 2019 00:27:49 +0200 Subject: tests: hackage: Test multiline cabal description. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/hackage.scm (test-cabal-multiline-desc): New variable. ("hackage->guix-package test multiline desc"): New test. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'tests/hackage.scm') diff --git a/tests/hackage.scm b/tests/hackage.scm index 269c1e1f9b..2f45194fab 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -236,6 +236,25 @@ library (test-assert "hackage->guix-package test 6" (eval-test-with-cabal test-cabal-6 match-ghc-foo-6)) +;; Check multi-line layouted description +(define test-cabal-multiline-desc + "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" + (eval-test-with-cabal test-cabal-multiline-desc match-ghc-foo)) + + (test-assert "read-cabal test 1" (match (call-with-input-string test-read-cabal-1 read-cabal) ((("name" ("test-me")) -- cgit v1.2.3 From 959c9d159da2c53b87ae0af1421aecac98b20f46 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Sun, 2 Jun 2019 00:27:50 +0200 Subject: import: hackage: Parse braced properties. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- guix/import/cabal.scm | 35 ++++++++++++++++++++++++++++------- tests/hackage.scm | 25 ++++++++++++++++++++++--- 2 files changed, 50 insertions(+), 10 deletions(-) (limited to 'tests/hackage.scm') diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm index 13c2f3f48c..1a87be0b00 100644 --- a/guix/import/cabal.scm +++ b/guix/import/cabal.scm @@ -270,6 +270,10 @@ following lines with indentation larger than MIN-INDENT." (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 @@ matching a string against the created regexp." (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 @@ string with the read characters." (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 @@ LOC is the current port location." 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 @@ the current port location." ((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 diff --git a/tests/hackage.scm b/tests/hackage.scm index 2f45194fab..38a5825af7 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -237,7 +237,7 @@ library (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 @@ executable cabal 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) -- cgit v1.2.3