* guix/import/crate/cargo-lock.scm: New file.
* Makefile.am (MODULES): Regisiter it.
* etc/teams.scm (rust)[#:scope]: Add it.
* guix/import/crate.scm (cargo-lock->definitions): New procedure.
Co-authored-by: Murilo <murilo@disroot.org>
Co-authored-by: Luis Guilherme Coelho <lgcoelho@disroot.org>
Change-Id: I95421e9e2ba11a671b4bc4e1323c6d31a1b012c5
---
Makefile.am | 1 +
etc/teams.scm | 1 +
guix/import/crate.scm | 78 +++++++++++++++++++++++
guix/import/crate/cargo-lock.scm | 105 +++++++++++++++++++++++++++++++
4 files changed, 185 insertions(+)
create mode 100644 guix/import/crate/cargo-lock.scm
@@ -295,6 +295,7 @@ MODULES = \
guix/import/cpan.scm \
guix/import/cran.scm \
guix/import/crate.scm \
+ guix/import/crate/cargo-lock.scm \
guix/import/egg.scm \
guix/import/elm.scm \
guix/import/elpa.scm \
@@ -389,6 +389,7 @@ (define-team rust
"guix/build/cargo-utils.scm"
"guix/build-system/cargo.scm"
"guix/import/crate.scm"
+ "guix/import/crate/cargo-lock.scm"
"guix/scripts/import/crate.scm"
"tests/crate.scm")))
@@ -9,6 +9,9 @@
;;; Copyright © 2023, 2024 David Elsing <david.elsing@posteo.net>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2025 Herman Rimm <herman@rimm.ee>
+;;; Copyright © 2024 Murilo <murilo@disroot.org>
+;;; Copyright © 2024-2025 Luis Guilherme Coelho <lgcoelho@disroot.org>
+;;; Copyright © 2025 Hilton Chain <hako@ultrarare.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,12 +29,14 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import crate)
+ #:use-module (guix base16)
#:use-module (guix base32)
#:use-module ((guix build-system cargo) #:hide (crate-source))
#:use-module (guix diagnostics)
#:use-module (gcrypt hash)
#:use-module (guix http-client)
#:use-module (guix i18n)
+ #:use-module (guix import crate cargo-lock)
#:use-module (guix import json)
#:use-module (guix import utils)
#:use-module (guix memoization)
@@ -39,9 +44,11 @@ (define-module (guix import crate)
#:use-module (guix read-print)
#:use-module (guix upstream)
#:use-module (guix utils)
+ #:use-module (guix scripts download)
#:use-module (gnu packages)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
+ #:use-module (ice-9 textual-ports)
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
@@ -52,6 +59,7 @@ (define-module (guix import crate)
guix-package->crate-name
string->license
crate-recursive-import
+ cargo-lock->definitions
%crate-updater))
@@ -481,6 +489,76 @@ (define (guix-package->crate-name package)
(match parts
((name _ ...) name))))
+
+;;;
+;;; Convert ‘Cargo.lock’ to Guix sources.
+;;;
+
+(define (cargo-lock->definitions lockfile package-name)
+ "Given LOCKFILE, a 'Cargo.lock' file, convert its content into source
+definitions. Return a list of sources and 'PACKAGE-NAME-cargo-inputs', an input
+list referencing all imported sources."
+ (define (crate->definition crate)
+ (match crate
+ (('crate
+ ('crate-name name)
+ ('crate-version version)
+ ('crate-source _)
+ ('crate-checksum checksum))
+ `(define
+ ,(string->symbol
+ (string-append (crate-name->package-name name) "-" version))
+ ,@(if (or (string-suffix? "src" name)
+ (string-suffix? "sys" name))
+ (list (comment ";; TODO: Check bundled sources.\n" #f))
+ '())
+ (crate-source ,name ,version
+ ,(bytevector->nix-base32-string
+ (base16-string->bytevector checksum)))))
+ ;; Git snapshot.
+ (('crate
+ ('crate-name name)
+ ('crate-version version)
+ ('crate-source source))
+ (begin
+ (let* ((src (string-split source (char-set #\+ #\? #\#)))
+ (url (second src))
+ (commit (last src))
+ (version (string-append version "." (string-take commit 7)))
+ (checksum
+ (second
+ (string-split
+ (with-output-to-string
+ (lambda _
+ (guix-download "-g" url
+ (string-append "--commit=" commit))))
+ #\newline))))
+ `(define
+ ,(string->symbol
+ (string-append (crate-name->package-name name) "-" version))
+ ,(comment
+ ";; TODO: Define standalone package if this is a workspace.\n"
+ #f)
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url ,url)
+ (commit ,commit)))
+ (file-name
+ (git-file-name ,(crate-name->package-name name) ,version))
+ (sha256 (base32 ,checksum)))))))
+ ;; Workspace member.
+ (else #f)))
+
+ (let ((definitions
+ (filter-map crate->definition
+ (cargo-lock-string->scm
+ (call-with-input-file lockfile get-string-all)))))
+ (values definitions
+ `(define-public
+ ,(string->symbol (string-append package-name "-cargo-inputs"))
+ (list ,@(map second definitions))))))
+
;;;
;;; Updater
new file mode 100644
@@ -0,0 +1,105 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Murilo <murilo@disroot.org>
+;;; Copyright © 2024 Luis Guilherme Coelho <lgcoelho@disroot.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import crate cargo-lock)
+ #:use-module (ice-9 peg)
+ #:export (cargo-lock-string->scm
+
+ crate-name
+ crate-version
+ crate-source
+ crate-checksum
+ crate-dependencies
+ cargo-lock))
+
+;;;
+;;; PEG parser for ‘Cargo.lock’.
+;;;
+
+(define (cargo-lock-string->scm str)
+ (peg:tree (search-for-pattern cargo-lock str)))
+
+;; Auxiliar peg patterns
+(define-peg-pattern numeric-char body
+ (range #\0 #\9))
+
+(define-peg-pattern lowercase-char body
+ (range #\a #\z))
+
+(define-peg-pattern uppercase-char body
+ (range #\A #\Z))
+
+(define-peg-pattern alphabetic-char body
+ (or lowercase-char uppercase-char))
+
+(define-peg-pattern alphanumeric-char body
+ (or alphabetic-char numeric-char))
+
+;; name
+(define-peg-pattern crate-name all
+ (+ (or "-" alphabetic-char
+ "_" numeric-char)))
+
+;; version
+(define-peg-pattern non-negative-integer body
+ (+ numeric-char))
+
+(define-peg-pattern crate-version all
+ (and non-negative-integer "."
+ non-negative-integer "."
+ non-negative-integer
+ (? (+ (or "-" lowercase-char
+ "." uppercase-char
+ "+" numeric-char "_")))))
+
+;; source
+(define-peg-pattern crate-source all
+ (and (or "registry" "git")
+ "+https://"
+ (+ (or "/" "." "?" "=" "-" "#" "_"
+ alphanumeric-char))))
+
+;; checksum
+(define-peg-pattern crate-checksum all
+ (+ (or lowercase-char numeric-char)))
+
+;; dependency specification
+(define-peg-pattern dependency-specification all
+ (and crate-name (? (and (ignore " ") crate-version))))
+
+;; dependencies
+(define-peg-pattern crate-dependencies all
+ (and (ignore "[\n")
+ (+ (and (ignore " \"")
+ (capture dependency-specification)
+ (ignore "\",\n")))
+ (ignore "]")))
+
+;; crates
+(define-peg-pattern crate all
+ (and (ignore "[[package]]\n")
+ (ignore "name = \"") (capture crate-name) (ignore "\"\n")
+ (ignore "version = \"") (capture crate-version) (ignore "\"\n")
+ (? (and (ignore "source = \"") (capture crate-source) (ignore "\"\n")))
+ (? (and (ignore "checksum = \"") (capture crate-checksum) (ignore "\"\n")))
+ (? (ignore (and "dependencies = " crate-dependencies "\n")))))
+
+;; Cargo.lock
+(define-peg-pattern cargo-lock all
+ (+ (and (ignore "\n") crate)))