zilch/lang/rust/src/registry.sld

(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 (equal? (lockfile-entry-source lockfile-entry) "registry+https://github.com/rust-lang/crates.io-index") (error "unknown 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) '())))))