(zilch lang rust): initial commit

lang/rust/src/registry.sld

@@ -0,0 +1,82 @@
+(define-library (zilch lang rust registry)
+ (import
+  (scheme base) (scheme write) (scheme process-context) (scheme lazy)
+  (zilch file) (zilch magic) (zilch nix drv) (zilch nix path)
+  (zilch nixpkgs) (zilch zexpr)
+  json
+  (chicken process)
+  (chicken base) (chicken format)
+  (chicken foreign)
+  (srfi 4) (srfi 152) (srfi 207))
+
+ (export
+   parse-lockfile fetch-and-unpack-crate
+   
+   lockfile-entry? lockfile-entry-name lockfile-entry-version lockfile-entry-source lockfile-entry-checksum lockfile-entry-dependencies)
+
+ (begin
+   ;; Shell out to a TOML-to-JSON parser. This will be replaced with a Nix-native solution later(tm).
+   (define (parse-toml toml-to-parse)
+     (define-values (read-port write-port pid) (process "yj" '("yj" "-tj")))
+     (write-string toml-to-parse write-port)
+     (close-output-port write-port)
+     (define parsed (json-read read-port))
+     (close-input-port read-port)
+     ; (define-values (_ _ _) (process-wait pid))
+     parsed)
+  
+   ;; TODO(puck): source here should probably be a record?
+   ;; dependencies here is a list of (name . version-or-#f). if #f, use any version (should be unambiguous!)
+   (define-record-type <lockfile-entry>
+     (make-lockfile-entry name version source checksum dependencies)
+     lockfile-entry?
+     (name lockfile-entry-name)
+     (version lockfile-entry-version)
+     (source lockfile-entry-source)
+     (checksum lockfile-entry-checksum)
+     (dependencies lockfile-entry-dependencies))
+  
+   (define-record-printer (<lockfile-entry> entry out)
+     (fprintf out "#<lockfile-entry ~A ~A ~A csum:~A deps:~A>"
+       (lockfile-entry-name entry)
+       (lockfile-entry-version entry)
+       (lockfile-entry-source entry)
+       (lockfile-entry-checksum entry)
+       (lockfile-entry-dependencies entry)))
+  
+   (define (fetch-and-unpack-crate lockfile-entry)
+     (unless (string=? (lockfile-entry-source lockfile-entry) "registry+https://github.com/rust-lang/crates.io-index") (error "unknown source " (lockfile-entry-source lockfile-entry)))
+       
+     ; TODO(puck): hardcoded
+     (define url (string-append "https://static.crates.io/crates/" (lockfile-entry-name lockfile-entry) "/" (lockfile-entry-version lockfile-entry) "/download"))
+     (define crate-name (string-append (lockfile-entry-name lockfile-entry) "-" (lockfile-entry-version lockfile-entry) ".crate"))
+     (define crate-name-path (string-append (lockfile-entry-name lockfile-entry) "-" (lockfile-entry-version lockfile-entry)))
+     (define fetched-tarball (store-path-for-fod crate-name "builtin" '("builtin:fetchurl") `(("url" . ,url)) "sha256" (lockfile-entry-checksum lockfile-entry) #f))
+     (define unpacked-tarball
+       (cdar (store-path-for-drv crate-name "builtin" '("builtin:unpack-channel")
+              #~(("src" . #$fetched-tarball)
+                 ("channelName" . #$crate-name-path)) '("out"))))
+     #~,(string-append #$unpacked-tarball "/" #$crate-name-path))
+
+   (define (parse-lockfile file-contents)
+     (define inputs (vector->list (parse-toml file-contents)))
+     (define lockfile-version (assoc "version" inputs))
+     (unless (and lockfile-version (>= (cdr lockfile-version) 3)) (error "Unknown lockfile version" lockfile-version))
+     (define packages (assoc "package" inputs))
+     (map
+       (lambda (package)
+         (define alist (vector->list package))
+         (define name (assoc "name" alist))
+         (define version (assoc "version" alist))
+         (define source (assoc "source" alist))
+         (define checksum (assoc "checksum" alist))
+         (define dependencies (assoc "dependencies" alist))
+
+         (define processed-dependencies
+           (if dependencies
+             (map (lambda (dep)
+                     (define index (string-contains dep " "))
+                     (if index (cons (string-copy dep 0 index) (string-copy dep (+ index 1))) (cons dep #f))) (cdr dependencies))
+             '()))
+         (make-lockfile-entry (cdr name) (cdr version) (and source (cdr source)) (and checksum (hex-string->bytevector (cdr checksum))) processed-dependencies))
+       (if packages (cdr packages) '())))))