import: Update opam importer.
* guix/import/opam.scm: Update importer for opam 2. * tests/opam.scm: Update tests for the opam 2 importer.
This commit is contained in:
parent
2a6ba9ff61
commit
cce654fabd
|
@ -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 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 (vhash-ref hashtable key default)
|
||||
(match (vhash-assoc key hashtable)
|
||||
(#f default)
|
||||
((_ . x) x)))
|
||||
(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 (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-peg-pattern condition body (and (ignore "{") condition-form (ignore "}")))
|
||||
|
||||
(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-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))))))))
|
||||
(fold (lambda (a b) (if (version>? a b) a b)) (car versions) versions))
|
||||
|
||||
(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 (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 (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 `())))
|
||||
(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)))))))
|
||||
|
|
|
@ -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
|
||||
|
|
225
tests/opam.scm
225
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")
|
||||
|
|
Loading…
Reference in New Issue