(zilch lang rust): parse workspaces

lang/rust/src/build-script.sld

@@ -128,6 +128,5 @@
 
    (define (call-runner input-script cwd env)
      (define output (store-path-for-ca-drv* "build.rs-run" "x86_64-linux" #~(#$runner-runner) #~(("script" . #$input-script) ("cwd" . #$cwd) ("OUT_DIR" . ,(make-placeholder "outdir")) . #$env) '("out" "outdir")))
-     (printf "meow ~S\n" output)
      (values (call-with-port (store-path-open (cdr (assoc "out" output))) parse-build-script-output) (cdr (assoc "outdir" output))))))
 

lang/rust/src/cargo.sld

@@ -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 (parse-cargo-package vfs internals workspace)
-     (define internals (vector->list (parse-toml cargo-file)))
      (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))))
+

lang/rust/src/resolver.sld

@@ -83,7 +83,7 @@
    ;; Download and activate a dependency from the registry.
    (define (resolver-download resolver name version)
      (define vfs (force (cddr (mapping-ref (mapping-ref (resolver-locked-dependencies resolver) name) (version-str version)))))
-     (define parsed-cargo (parse-cargo-toml vfs (call-with-port (store-path-open #~,(string-append #$vfs "/Cargo.toml")) (lambda (p) (read-string 99999999 p)))))
+     (define-values (parsed-cargo parsed-workspace) (parse-cargo-toml vfs (call-with-port (store-path-open #~,(string-append #$vfs "/Cargo.toml")) (lambda (p) (read-string 99999999 p))) #f))
      (unless (cargo-crate-lib-target parsed-cargo)
        (error "Crate does not have valid [lib] target" (list name version)))
        
@@ -220,7 +220,7 @@
       parsed-lockfile)
 
      (define resolver (make-resolver locked-dependencies (mapping (make-default-comparator))))
-     (define pkg (resolver-register resolver vfs cargo-file))
+     (define pkg (resolver-register resolver vfs cargo-file #f))
      (resolver-activate-features resolver pkg activated-features)
      (resolver-print resolver)
      pkg)