[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: import: Update opam importer.
|
From: |
guix-commits |
|
Subject: |
02/02: import: Update opam importer. |
|
Date: |
Mon, 17 Dec 2018 15:45:00 -0500 (EST) |
roptat pushed a commit to branch master
in repository guix.
commit cce654fabdf09cac7d18f9bad842ba8445aa022c
Author: Julien Lepiller <address@hidden>
Date: Mon Dec 17 21:05:35 2018 +0100
import: Update opam importer.
* guix/import/opam.scm: Update importer for opam 2.
* tests/opam.scm: Update tests for the opam 2 importer.
---
guix/import/opam.scm | 305 ++++++++++++++++++++++++++++-----------------------
po/guix/POTFILES.in | 1 +
tests/opam.scm | 225 +++++++++++++++++++++++++------------
3 files changed, 321 insertions(+), 210 deletions(-)
diff --git a/guix/import/opam.scm b/guix/import/opam.scm
index f252bdc..c42a5d7 100644
--- a/guix/import/opam.scm
+++ b/guix/import/opam.scm
@@ -17,132 +17,108 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import opam)
+ #:use-module (ice-9 ftw)
#:use-module (ice-9 match)
- #:use-module (ice-9 vlist)
+ #:use-module (ice-9 peg)
+ #:use-module (ice-9 receive)
#:use-module ((ice-9 rdelim) #:select (read-line))
+ #:use-module (ice-9 textual-ports)
+ #:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-2)
#:use-module (web uri)
#:use-module (guix http-client)
+ #:use-module (guix git)
+ #:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix import utils)
#:use-module ((guix licenses) #:prefix license:)
#:export (opam->guix-package))
-(define (opam-urls)
- "Fetch the urls.txt file from the opam repository and returns the list of
-URLs it contains."
- (let ((port (http-fetch/cached (string->uri
"https://opam.ocaml.org/urls.txt";))))
- (let loop ((result '()))
- (let ((line (read-line port)))
- (if (eof-object? line)
- (begin
- (close port)
- result)
- (loop (cons line result)))))))
-
-(define (vhash-ref hashtable key default)
- (match (vhash-assoc key hashtable)
- (#f default)
- ((_ . x) x)))
-
-(define (hashtable-update hashtable line)
- "Parse @var{line} to get the name and version of the package and adds them
-to the hashtable."
- (let* ((line (string-split line #\ )))
- (match line
- ((url foo ...)
- (if (equal? url "repo")
- hashtable
- (match (string-split url #\/)
- ((type name1 versionstr foo ...)
- (if (equal? type "packages")
- (match (string-split versionstr #\.)
- ((name2 versions ...)
- (let ((version (string-join versions ".")))
- (if (equal? name1 name2)
- (let ((curr (vhash-ref hashtable name1 '())))
- (vhash-cons name1 (cons version curr) hashtable))
- hashtable)))
- (_ hashtable))
- hashtable))
- (_ hashtable))))
- (_ hashtable))))
-
-(define (urls->hashtable urls)
- "Transform urls.txt in a hashtable whose keys are package names and values
-the list of available versions."
- (let ((hashtable vlist-null))
- (let loop ((urls urls) (hashtable hashtable))
- (match urls
- (() hashtable)
- ((url rest ...) (loop rest (hashtable-update hashtable url)))))))
+;; Define a PEG parser for the opam format
+(define-peg-pattern SP none (or " " "\n"))
+(define-peg-pattern SP2 body (or " " "\n"))
+(define-peg-pattern QUOTE none "\"")
+(define-peg-pattern QUOTE2 body "\"")
+(define-peg-pattern COLON none ":")
+;; A string character is any character that is not a quote, or a quote
preceded by a backslash.
+(define-peg-pattern STRCHR body
+ (or " " "!" (and (ignore "\\") "\"")
+ (and (ignore "\\") "\\") (range #\# #\頋)))
+(define-peg-pattern operator all (or "=" "!" "<" ">"))
+
+(define-peg-pattern records body (* (and (or record weird-record) (* SP))))
+(define-peg-pattern record all (and key COLON (* SP) value))
+(define-peg-pattern weird-record all (and key (* SP) dict))
+(define-peg-pattern key body (+ (or (range #\a #\z) "-")))
+(define-peg-pattern value body (and (or conditional-value ground-value
operator) (* SP)))
+(define-peg-pattern ground-value body (and (or multiline-string string-pat
list-pat var) (* SP)))
+(define-peg-pattern conditional-value all (and ground-value (* SP) condition))
+(define-peg-pattern string-pat all (and QUOTE (* STRCHR) QUOTE))
+(define-peg-pattern list-pat all (and (ignore "[") (* SP) (* (and value (*
SP))) (ignore "]")))
+(define-peg-pattern var all (+ (or (range #\a #\z) "-")))
+(define-peg-pattern multiline-string all
+ (and QUOTE QUOTE QUOTE (* SP)
+ (* (or SP2 STRCHR (and QUOTE2 (not-followed-by QUOTE))
+ (and QUOTE2 QUOTE2 (not-followed-by QUOTE))))
+ QUOTE QUOTE QUOTE))
+(define-peg-pattern dict all (and (ignore "{") (* SP) records (* SP) (ignore
"}")))
+
+(define-peg-pattern condition body (and (ignore "{") condition-form (ignore
"}")))
+
+(define-peg-pattern condition-form body
+ (and
+ (* SP)
+ (or condition-and condition-or condition-form2)
+ (* SP)))
+(define-peg-pattern condition-form2 body
+ (and (* SP) (or condition-greater-or-equal
condition-greater
+ condition-lower-or-equal condition-lower
+ condition-neq condition-eq
condition-content) (* SP)))
+
+;(define-peg-pattern condition-operator all (and (ignore operator) (* SP)
condition-string))
+(define-peg-pattern condition-greater-or-equal all (and (ignore (and ">" "="))
(* SP) condition-string))
+(define-peg-pattern condition-greater all (and (ignore ">") (* SP)
condition-string))
+(define-peg-pattern condition-lower-or-equal all (and (ignore (and "<" "="))
(* SP) condition-string))
+(define-peg-pattern condition-lower all (and (ignore "<") (* SP)
condition-string))
+(define-peg-pattern condition-and all (and condition-form2 (* SP) (? (ignore
"&")) (* SP) condition-form))
+(define-peg-pattern condition-or all (and condition-form2 (* SP) (ignore "|")
(* SP) condition-form))
+(define-peg-pattern condition-eq all (and condition-content (* SP) (ignore
"=") (* SP) condition-content))
+(define-peg-pattern condition-neq all (and condition-content (* SP) (ignore
(and "!" "=")) (* SP) condition-content))
+(define-peg-pattern condition-content body (or condition-string condition-var))
+(define-peg-pattern condition-content2 body (and condition-content (* SP)
(not-followed-by (or "&" "=" "!"))))
+(define-peg-pattern condition-string all (and QUOTE (* STRCHR) QUOTE))
+(define-peg-pattern condition-var all (+ (or (range #\a #\z) "-")))
+
+(define (get-opam-repository)
+ "Update or fetch the latest version of the opam repository and return the
+path to the repository."
+ (receive (location commit)
+ (update-cached-checkout "https://github.com/ocaml/opam-repository";)
+ location))
(define (latest-version versions)
"Find the most recent version from a list of versions."
- (match versions
- ((first rest ...)
- (let loop ((versions rest) (m first))
- (match versions
- (() m)
- ((first rest ...)
- (loop rest (if (version>? m first) m first))))))))
-
-(define (fetch-package-url uri)
- "Fetch and parse the url file. Return the URL the package can be downloaded
-from."
- (let ((port (http-fetch uri)))
- (let loop ((result #f))
- (let ((line (read-line port)))
- (if (eof-object? line)
- (begin
- (close port)
- result)
- (let* ((line (string-split line #\ )))
- (match line
- ((key value rest ...)
- (if (member key '("archive:" "http:"))
- (loop (string-trim-both value #\"))
- (loop result))))))))))
-
-(define (fetch-package-metadata uri)
- "Fetch and parse the opam file. Return an association list containing the
-homepage, the license and the list of inputs."
- (let ((port (http-fetch uri)))
- (let loop ((result '()) (dependencies? #f))
- (let ((line (read-line port)))
- (if (eof-object? line)
- (begin
- (close port)
- result)
- (let* ((line (string-split line #\ )))
- (match line
- ((key value ...)
- (let ((dependencies?
- (if dependencies?
- (not (equal? key "]"))
- (equal? key "depends:")))
- (val (string-trim-both (string-join value "") #\")))
- (cond
- ((equal? key "homepage:")
- (loop (cons `("homepage" . ,val) result) dependencies?))
- ((equal? key "license:")
- (loop (cons `("license" . ,val) result) dependencies?))
- ((and dependencies? (not (equal? val "[")))
- (match (string-split val #\{)
- ((val rest ...)
- (let ((curr (assoc-ref result "inputs"))
- (new (string-trim-both
- val (list->char-set '(#\] #\[ #\")))))
- (loop (cons `("inputs" . ,(cons new (if curr curr
'()))) result)
- (if (string-contains val "]") #f
dependencies?))))))
- (else (loop result dependencies?))))))))))))
-
-(define (string->license str)
- (cond
- ((equal? str "MIT") '(license:expat))
- ((equal? str "GPL2") '(license:gpl2))
- ((equal? str "LGPLv2") '(license:lgpl2))
- (else `())))
+ (fold (lambda (a b) (if (version>? a b) a b)) (car versions) versions))
+
+(define (find-latest-version package repository)
+ "Get the latest version of a package as described in the given repository."
+ (let* ((dir (string-append repository "/packages/" package))
+ (versions (scandir dir (lambda (name) (not (string-prefix? "."
name))))))
+ (if versions
+ (let ((versions (map
+ (lambda (dir)
+ (string-join (cdr (string-split dir #\.)) "."))
+ versions)))
+ (latest-version versions))
+ (begin
+ (format #t (G_ "Package not found in opam repository: ~a~%") package)
+ #f))))
+
+(define (get-metadata opam-file)
+ (with-input-from-file opam-file
+ (lambda _
+ (peg:tree (match-pattern records (get-string-all
(current-input-port)))))))
(define (ocaml-name->guix-name name)
(cond
@@ -151,33 +127,85 @@ homepage, the license and the list of inputs."
((string-prefix? "conf-" name) (substring name 5))
(else (string-append "ocaml-" name))))
-(define (dependencies->inputs dependencies)
- "Transform the list of dependencies in a list of inputs."
- (if (not dependencies)
- '()
- (map (lambda (input)
- (list input (list 'unquote (string->symbol input))))
- (map ocaml-name->guix-name dependencies))))
+(define (metadata-ref file lookup)
+ (pk 'file file 'lookup lookup)
+ (fold (lambda (record acc)
+ (match record
+ ((record key val)
+ (if (equal? key lookup)
+ (match val
+ (('list-pat . stuff) stuff)
+ (('string-pat stuff) stuff)
+ (('multiline-string stuff) stuff)
+ (('dict records ...) records))
+ acc))))
+ #f file))
+
+(define (native? condition)
+ (match condition
+ (('condition-var var)
+ (match var
+ ("with-test" #t)
+ ("test" #t)
+ ("build" #t)
+ (_ #f)))
+ ((or ('condition-or cond-left cond-right) ('condition-and cond-left
cond-right))
+ (or (native? cond-left)
+ (native? cond-right)))
+ (_ #f)))
+
+(define (dependency->input dependency)
+ (match dependency
+ (('string-pat str) str)
+ (('conditional-value val condition)
+ (if (native? condition) "" (dependency->input val)))))
+
+(define (dependency->native-input dependency)
+ (match dependency
+ (('string-pat str) "")
+ (('conditional-value val condition)
+ (if (native? condition) (dependency->input val) ""))))
+
+(define (ocaml-names->guix-names names)
+ (map ocaml-name->guix-name
+ (remove (lambda (name)
+ (or (equal? "" name))
+ (equal? "ocaml" name))
+ names)))
+
+(define (depends->inputs depends)
+ (filter (lambda (name)
+ (and (not (equal? "" name))
+ (not (equal? "ocaml" name))
+ (not (equal? "ocamlfind" name))))
+ (map dependency->input depends)))
+
+(define (depends->native-inputs depends)
+ (filter (lambda (name) (not (equal? "" name)))
+ (map dependency->native-input depends)))
+
+(define (dependency-list->inputs lst)
+ (map
+ (lambda (dependency)
+ (list dependency (list 'unquote (string->symbol dependency))))
+ (ocaml-names->guix-names lst)))
(define (opam->guix-package name)
- (let* ((hashtable (urls->hashtable (opam-urls)))
- (versions (vhash-ref hashtable name #f)))
- (unless (eq? versions #f)
- (let* ((version (latest-version versions))
- (package-url (string-append "https://opam.ocaml.org/packages/";
name
- "/" name "." version "/"))
- (url-url (string-append package-url "url"))
- (opam-url (string-append package-url "opam"))
- (source-url (fetch-package-url url-url))
- (metadata (fetch-package-metadata opam-url))
- (dependencies (assoc-ref metadata "inputs"))
- (inputs (dependencies->inputs dependencies)))
+ (and-let* ((repository (get-opam-repository))
+ (version (find-latest-version name repository))
+ (file (string-append repository "/packages/" name "/" name "."
(pk 'version version) "/opam"))
+ (opam-content (get-metadata file))
+ (url-dict (metadata-ref (pk 'metadata opam-content) "url"))
+ (source-url (metadata-ref url-dict "src"))
+ (requirements (metadata-ref opam-content "depends"))
+ (inputs (dependency-list->inputs (depends->inputs requirements)))
+ (native-inputs (dependency-list->inputs (depends->native-inputs
requirements))))
(call-with-temporary-output-file
(lambda (temp port)
(and (url-fetch source-url temp)
`(package
(name ,(ocaml-name->guix-name name))
- (version ,version)
+ (version ,(metadata-ref opam-content "version"))
(source
(origin
(method url-fetch)
@@ -187,7 +215,10 @@ homepage, the license and the list of inputs."
,@(if (null? inputs)
'()
`((inputs ,(list 'quasiquote inputs))))
- (home-page ,(assoc-ref metadata "homepage"))
- (synopsis "")
- (description "")
- (license ,@(string->license (assoc-ref metadata
"license")))))))))))
+ ,@(if (null? native-inputs)
+ '()
+ `((native-inputs ,(list 'quasiquote native-inputs))))
+ (home-page ,(metadata-ref opam-content "homepage"))
+ (synopsis ,(metadata-ref opam-content "synopsis"))
+ (description ,(metadata-ref opam-content "description"))
+ (license #f)))))))
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index e0da801..c432973 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -7,6 +7,7 @@ gnu/system.scm
gnu/services/shepherd.scm
gnu/system/mapped-devices.scm
gnu/system/shadow.scm
+guix/import/opam.scm
guix/scripts.scm
guix/scripts/build.scm
guix/discovery.scm
diff --git a/tests/opam.scm b/tests/opam.scm
index a1320ab..e0ec5ef 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -21,98 +21,177 @@
#:use-module (guix base32)
#:use-module (gcrypt hash)
#:use-module (guix tests)
+ #:use-module ((guix build syscalls) #:select (mkdtemp!))
#:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p
which))
+ #:use-module ((guix utils) #:select (call-with-temporary-output-file))
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
#:use-module (web uri)
- #:use-module (ice-9 match))
-
-(define test-url-file
- "http: \"https://example.org/foo-1.0.0.tar.gz\";
-checksum: \"ac8920f39a8100b94820659bc2c20817\"")
-
-(define test-source-hash
- "")
-
-(define test-urls
- "repo ac8920f39a8100b94820659bc2c20817 0o644
-packages/foo/foo.1.0.0/url ac8920f39a8100b94820659bc2c20817 0o644
-packages/foo/foo.1.0.0/opam ac8920f39a8100b94820659bc2c20817 0o644
-packages/foo/foo.1.0.0/descr ac8920f39a8100b94820659bc2c20817 0o644")
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 peg))
(define test-opam-file
-"opam-version: 1.2
+"opam-version: \"2.0\"
+ version: \"1.0.0\"
maintainer: \"Alice Doe\"
-authors: \"Alice Doe, John Doe\"
+authors: [
+ \"Alice Doe\"
+ \"John Doe\"
+]
homepage: \"https://example.org/\";
bug-reports: \"https://example.org/bugs\";
-license: \"MIT\"
dev-repo: \"https://example.org/git\";
build: [
- \"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\"
+ [\"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\"]
]
build-test: [
- \"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\" \"--tests\"
\"true\"
+ [\"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\" \"--tests\"
\"true\"]
]
depends: [
\"alcotest\" {test & >= \"0.7.2\"}
\"ocamlbuild\" {build & >= \"0.9.2\"}
-]")
+ \"zarith\" {>= \"0.7\"}
+]
+synopsis: \"Some example package\"
+description: \"\"\"
+This package is just an example.\"\"\"
+url {
+ src: \"https://example.org/foo-1.0.0.tar.gz\";
+ checksum: \"md5=74c6e897658e820006106f45f736381f\"
+}")
+
+(define test-source-hash
+ "")
+
+(define test-repo
+ (mkdtemp! "/tmp/opam-repo.XXXXXX"))
(test-begin "opam")
(test-assert "opam->guix-package"
- ;; Replace network resources with sample data.
- (mock ((guix import utils) url-fetch
- (lambda (url file-name)
- (match url
- ("https://example.org/foo-1.0.0.tar.gz";
- (begin
- (mkdir-p "foo-1.0.0")
- (system* "tar" "czvf" file-name "foo-1.0.0/")
- (delete-file-recursively "foo-1.0.0")
- (set! test-source-hash
- (call-with-input-file file-name port-sha256))))
- (_ (error "Unexpected URL: " url)))))
- (mock ((guix http-client) http-fetch/cached
- (lambda (url . rest)
- (match (uri->string url)
- ("https://opam.ocaml.org/urls.txt";
- (values (open-input-string test-urls)
- (string-length test-urls)))
- (_ (error "Unexpected URL: " url)))))
- (mock ((guix http-client) http-fetch
- (lambda (url . rest)
- (match url
- ("https://opam.ocaml.org/packages/foo/foo.1.0.0/url";
- (values (open-input-string test-url-file)
- (string-length test-url-file)))
-
("https://opam.ocaml.org/packages/foo/foo.1.0.0/opam";
- (values (open-input-string test-opam-file)
- (string-length test-opam-file)))
- (_ (error "Unexpected URL: " url)))))
- (match (opam->guix-package "foo")
- (('package
- ('name "ocaml-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri
"https://example.org/foo-1.0.0.tar.gz";)
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'ocaml-build-system)
- ('inputs
- ('quasiquote
- (("ocamlbuild" ('unquote 'ocamlbuild))
- ("ocaml-alcotest" ('unquote 'ocaml-alcotest)))))
- ('home-page "https://example.org/";)
- ('synopsis "")
- ('description "")
- ('license 'license:expat))
- (string=? (bytevector->nix-base32-string
- test-source-hash)
- hash))
- (x
- (pk 'fail x #f)))))))
+ (mock ((guix import utils) url-fetch
+ (lambda (url file-name)
+ (match url
+ ("https://example.org/foo-1.0.0.tar.gz";
+ (begin
+ (mkdir-p "foo-1.0.0")
+ (system* "tar" "czvf" file-name "foo-1.0.0/")
+ (delete-file-recursively "foo-1.0.0")
+ (set! test-source-hash
+ (call-with-input-file file-name port-sha256))))
+ (_ (error "Unexpected URL: " url)))))
+ (let ((my-package (string-append test-repo "/packages/foo/foo.1.0.0")))
+ (mkdir-p my-package)
+ (with-output-to-file (string-append my-package "/opam")
+ (lambda _
+ (format #t "~a" test-opam-file))))
+ (mock ((guix import opam) get-opam-repository
+ (lambda _
+ test-repo))
+ (match (opam->guix-package "foo")
+ (('package
+ ('name "ocaml-foo")
+ ('version "1.0.0")
+ ('source ('origin
+ ('method 'url-fetch)
+ ('uri "https://example.org/foo-1.0.0.tar.gz";)
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'ocaml-build-system)
+ ('inputs
+ ('quasiquote
+ (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
+ ('native-inputs
+ ('quasiquote
+ (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
+ ("ocamlbuild" ('unquote 'ocamlbuild)))))
+ ('home-page "https://example.org/";)
+ ('synopsis "Some example package")
+ ('description "This package is just an example.")
+ ('license #f))
+ (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash))
+ (x
+ (pk 'fail x #f))))))
+
+;; Test the opam file parser
+;; We fold over some test cases. Each case is a pair of the string to parse
and the
+;; expected result.
+(test-assert "parse-strings"
+ (fold (lambda (test acc)
+ (display test) (newline)
+ (and acc
+ (let ((result (peg:tree (match-pattern (@@ (guix import opam)
string-pat) (car test)))))
+ (if (equal? result (cdr test))
+ #t
+ (pk 'fail (list (car test) result (cdr test)) #f)))))
+ #t '(("" . #f)
+ ("\"hello\"" . (string-pat "hello"))
+ ("\"hello world\"" . (string-pat "hello world"))
+ ("\"The dreaded \\\"é\\\"\"" . (string-pat "The dreaded \"é\""))
+ ("\"Have some \\\\\\\\ :)\"" . (string-pat "Have some \\\\ :)"))
+ ("\"今日は\"" . (string-pat "今日は")))))
+
+(test-assert "parse-multiline-strings"
+ (fold (lambda (test acc)
+ (display test) (newline)
+ (and acc
+ (let ((result (peg:tree (match-pattern (@@ (guix import opam)
multiline-string) (car test)))))
+ (if (equal? result (cdr test))
+ #t
+ (pk 'fail (list (car test) result (cdr test)) #f)))))
+ #t '(("" . #f)
+ ("\"\"\"hello\"\"\"" . (multiline-string "hello"))
+ ("\"\"\"hello \"world\"!\"\"\"" . (multiline-string "hello
\"world\"!"))
+ ("\"\"\"hello \"\"world\"\"!\"\"\"" . (multiline-string "hello
\"\"world\"\"!")))))
+
+(test-assert "parse-lists"
+ (fold (lambda (test acc)
+ (and acc
+ (let ((result (peg:tree (match-pattern (@@ (guix import opam)
list-pat) (car test)))))
+ (if (equal? result (cdr test))
+ #t
+ (pk 'fail (list (car test) result (cdr test)) #f)))))
+ #t '(("" . #f)
+ ("[]" . list-pat)
+ ("[make]" . (list-pat (var "make")))
+ ("[\"make\"]" . (list-pat (string-pat "make")))
+ ("[\n a\n b\n c]" . (list-pat (var "a") (var "b") (var "c")))
+ ("[a b \"c\"]" . (list-pat (var "a") (var "b") (string-pat
"c"))))))
+
+(test-assert "parse-dicts"
+ (fold (lambda (test acc)
+ (and acc
+ (let ((result (peg:tree (match-pattern (@@ (guix import opam)
dict) (car test)))))
+ (if (equal? result (cdr test))
+ #t
+ (pk 'fail (list (car test) result (cdr test)) #f)))))
+ #t '(("" . #f)
+ ("{}" . dict)
+ ("{a: \"b\"}" . (dict (record "a" (string-pat "b"))))
+ ("{a: \"b\"\nc: \"d\"}" . (dict (record "a" (string-pat "b")) (record
"c" (string-pat "d")))))))
+
+(test-assert "parse-conditions"
+ (fold (lambda (test acc)
+ (and acc
+ (let ((result (peg:tree (match-pattern (@@ (guix import opam)
condition) (car test)))))
+ (if (equal? result (cdr test))
+ #t
+ (pk 'fail (list (car test) result (cdr test)) #f)))))
+ #t '(("" . #f)
+ ("{}" . #f)
+ ("{build}" . (condition-var "build"))
+ ("{>= \"0.2.0\"}" . (condition-greater-or-equal
+ (condition-string "0.2.0")))
+ ("{>= \"0.2.0\" & test}" . (condition-and
+ (condition-greater-or-equal
+ (condition-string "0.2.0"))
+ (condition-var "test")))
+ ("{>= \"0.2.0\" | build}" . (condition-or
+ (condition-greater-or-equal
+ (condition-string "0.2.0"))
+ (condition-var "build"))))))
(test-end "opam")