(zilch lang rust): parse workspaces

This commit is contained in:
puck 2024-11-27 14:16:01 +00:00
parent 2f069f2cdd
commit 9f23179d46
3 changed files with 75 additions and 12 deletions

View file

@ -33,6 +33,9 @@
cargo-crate-build-dependencies cargo-crate-build-script
cargo-crate-links
<cargo-workspace> make-cargo-workspace cargo-workspace?
cargo-workspace-members cargo-workspace-exclude cargo-workspace-dependencies
parse-cargo-toml)
(begin
@ -142,11 +145,12 @@
(cargo-dependency-optional entry)))
(define-record-type <cargo-crate>
(make-cargo-crate name version edition dependencies build-dependencies features lib-target build-script targets links)
(make-cargo-crate name version edition workspace dependencies build-dependencies features lib-target build-script targets links)
cargo-crate?
(name cargo-crate-name)
(version cargo-crate-version)
(edition cargo-crate-edition)
(workspace cargo-crate-workspace)
(dependencies cargo-crate-dependencies)
(build-dependencies cargo-crate-build-dependencies)
(features cargo-crate-features)
@ -164,6 +168,19 @@
(cargo-crate-features entry)
(cargo-crate-lib-target entry)
(cargo-crate-targets entry)))
(define-record-type <cargo-workspace>
(make-cargo-workspace members exclude dependencies)
cargo-workspace?
(members cargo-workspace-members)
(exclude cargo-workspace-exclude)
(dependencies cargo-workspace-dependencies))
(define-record-printer (<cargo-workspace> entry out)
(fprintf out "#<cargo-workspace members:~S exclude:~S deps:~S>"
(cargo-workspace-members entry)
(cargo-workspace-exclude entry)
(cargo-workspace-dependencies entry)))
; TODO(puck): aaaa
(define cfg-target "x86_64-unknown-linux-gnu")
@ -216,7 +233,13 @@
(define (and-cdr-default val default)
(if val (cdr val) default))
(define (cargo-dependency-from-toml name object)
(define (find-dependency-in-list l dep-name)
(cond
((null? l) #f)
((string=? dep-name (cargo-dependency-name (car l))) (car l))
(else (find-dependency-in-list (cdr l) dep-name))))
(define (cargo-dependency-from-toml name object workspace)
(define object-internals (vector->list object))
(define version (and-cdr (assoc "version" object-internals)))
(define default-features (and-cdr-default (assoc "default-features" object-internals) #t))
@ -231,8 +254,25 @@
(define registry-name (and-cdr (assoc "registry" object-internals)))
(define path (and-cdr (assoc "path" object-internals)))
(define is-workspace (and-cdr (assoc "workspace" object-internals)))
(when (and is-workspace (not workspace))
(error "Dependency uses workspace=true, whilst not a workspace" (cons name object-internals)))
(define workspace-dep
(and is-workspace (find-dependency-in-list (cargo-workspace-dependencies workspace) name)))
(when (and is-workspace (not workspace-dep))
(error "Dependency could not be found in workspace" name))
(when workspace-dep
(set! version (cargo-dependency-version workspace-dep))
(set! default-features (cargo-dependency-default-features workspace-dep))
(for-each
(lambda (feature) (unless (member feature pkg-features)) (set! pkg-features (cons feature pkg-features)))
(cargo-dependency-features workspace-dep))
(set! package (cargo-dependency-package workspace-dep)))
(define origin (cond
(workspace-dep (cargo-dependency-origin workspace-dep))
(path (make-cargo-dep-path path))
(registry-name (make-cargo-dep-registry registry-name))
((and git-url git-tag) (make-cargo-dep-git git-url 'tag git-tag))
@ -301,8 +341,7 @@
(mapping-for-each (lambda (k v) (when v (set! parsed (cons (list k (cons k (cons #t #f))) parsed)))) needs-implicit-dependency)
parsed)
(define (parse-cargo-toml vfs cargo-file)
(define internals (vector->list (parse-toml cargo-file)))
(define (parse-cargo-package vfs internals workspace)
(define package (vector->list (cdr (assoc "package" internals))))
(define package-name (cdr (assoc "name" package)))
(define package-version (cdr (assoc "version" package)))
@ -329,14 +368,14 @@
(define dependencies
(map
(lambda (kv)
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv))))
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) workspace))
(vector->list (or (and-cdr (assoc "dependencies" internals)) #()))))
;; TODO(puck): target.{matching cfg}.build-dependencies???
(define build-dependencies
(map
(lambda (kv)
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv))))
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) workspace))
(vector->list (or (and-cdr (assoc "build-dependencies" internals)) #()))))
; Merge in dependencies in target.{matching cfg or target}.dependencies?
@ -353,10 +392,35 @@
(append
(map
(lambda (kv)
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv))))
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) workspace))
(vector->list (or (and-cdr (assoc "dependencies" (vector->list contents))) #())))
dependencies))))
(vector->list (or (and-cdr (assoc "target" internals)) #())))
(define own-features (parse-features (vector->list (or (and-cdr (assoc "features" internals)) #())) (map cargo-dependency-name dependencies)))
(make-cargo-crate package-name package-version package-edition dependencies build-dependencies own-features lib-target build-script-target other-targets package-links))))
(make-cargo-crate package-name package-version package-edition workspace dependencies build-dependencies own-features lib-target build-script-target other-targets package-links))
(define (parse-cargo-workspace internals)
(define workspace (vector->list (cdr (assoc "workspace" internals))))
(define workspace-members (or (and-cdr (assoc "members" workspace)) '()))
(define workspace-exclude (or (and-cdr (assoc "exclude" workspace)) '()))
(define dependencies
(map
(lambda (kv)
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) #f))
(vector->list (or (and-cdr (assoc "dependencies" workspace)) #()))))
(make-cargo-workspace workspace-members workspace-exclude dependencies))
(define (parse-cargo-toml vfs cargo-file workspace)
(define internals (vector->list (parse-toml cargo-file)))
(define crate #f)
(when (assoc "workspace" internals)
(when workspace
(error "Crate already is in a workspace." cargo-file))
(set! workspace (parse-cargo-workspace internals)))
(when (assoc "package" internals)
(set! crate (parse-cargo-package vfs internals workspace)))
(values crate workspace))))