~ruther/guix-local

f27fb840c2d21f7c29db204519ef94f3634e1a55 — Hilton Chain 1 year, 2 months ago 4e8eab6
import: crate: Add Cargo.lock parser.

* guix/import/crate/cargo-lock.scm: New file.
* Makefile.am (MODULES): Regisiter it.
* etc/teams.scm (rust)[#:scope]: Add it.
* CODEOWNERS: Add it.
* guix/import/crate.scm (cargo-lock->expressions): New procedure.
* tests/crate.scm (temp-file): New variable.
("crate-lockfile-import"): New test.

Co-authored-by: Murilo <murilo@disroot.org>
Co-authored-by: Luis Guilherme Coelho <lgcoelho@disroot.org>
Change-Id: I95421e9e2ba11a671b4bc4e1323c6d31a1b012c5
6 files changed, 273 insertions(+), 0 deletions(-)

M CODEOWNERS
M Makefile.am
M etc/teams.scm
M guix/import/crate.scm
A guix/import/crate/cargo-lock.scm
M tests/crate.scm
M CODEOWNERS => CODEOWNERS +1 -0
@@ 308,6 308,7 @@ guix/build/cargo-build-system\.scm                 @guix/rust
guix/build/cargo-utils\.scm                        @guix/rust
guix/build-system/cargo\.scm                       @guix/rust
guix/import/crate\.scm                             @guix/rust
guix/import/crate/cargo-lock\.scm                  @guix/rust
guix/scripts/import/crate\.scm                     @guix/rust
tests/crate\.scm                                   @guix/rust


M Makefile.am => Makefile.am +1 -0
@@ 298,6 298,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   			\

M etc/teams.scm => etc/teams.scm +1 -0
@@ 923,6 923,7 @@ importer."
                      "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")))


M guix/import/crate.scm => guix/import/crate.scm +78 -0
@@ 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 @@
  #: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 @@
            guix-package->crate-name
            string->license
            crate-recursive-import
            cargo-lock->expressions
            %crate-updater))




@@ 483,6 491,76 @@ look up the development dependencs for the given crate."


;;;
;;; Convert ‘Cargo.lock’ to Guix sources.
;;;

(define (cargo-lock->expressions lockfile package-name)
  "Given LOCKFILE, a 'Cargo.lock' file, import its content as source
expressions.  Return a source list and a Cargo inputs entry for PACKAGE-NAME
referencing all imported sources."
  (define (crate->guix-source 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)))))))
      ;; Cargo workspace member.
      (else #f)))

  (let* ((source-expressions
          (filter-map crate->guix-source
                      (cargo-lock-string->scm
                       (call-with-input-file lockfile get-string-all))))
         (cargo-inputs-entry
          `(,(string->symbol package-name) =>
            (list ,@(map second source-expressions)))))
    (values source-expressions cargo-inputs-entry)))


;;;
;;; Updater
;;;


A guix/import/crate/cargo-lock.scm => guix/import/crate/cargo-lock.scm +105 -0
@@ 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)))

M tests/crate.scm => tests/crate.scm +87 -0
@@ 34,6 34,7 @@
  #:use-module (gnu packages)
  #:use-module (ice-9 iconv)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-64))




@@ 476,6 477,9 @@
    (description #f)
    (license #f)))

(define temp-file
  (string-append "t-crate-" (number->string (getpid))))


(test-begin "crate")



@@ 1178,4 1182,87 @@
          (x
           (pk 'fail (pretty-print-with-comments (current-output-port) x) #f)))))


(test-assert "crate-lockfile-import"
  (begin
    (call-with-output-file temp-file
      (lambda (port)
        (display "\
# This file is automatically @generated by Cargo.
# It is not intended for manual editing.
version = 3

[[package]]
name = \"adler2\"
version = \"2.0.0\"
source = \"registry+https://github.com/rust-lang/crates.io-index\"
checksum = \"512761e0bb2578dd7380c6baaa0f4ce03e84f95e960231d1dec8bf4d7d6e2627\"

[[package]]
name = \"aho-corasick\"
version = \"1.1.3\"
source = \"registry+https://github.com/rust-lang/crates.io-index\"
checksum = \"8e60d3430d3a69478ad0993f19238d2df97c507009a52b3c10addcd7f6bcb916\"
dependencies = [
 \"memchr\",
]

[[package]]
name = \"smithay\"
version = \"0.4.0\"
source = \"git+https://github.com/Smithay/smithay.git?rev=\
0cd3345c59f7cb139521f267956a1a4e33248393#\
0cd3345c59f7cb139521f267956a1a4e33248393\"
dependencies = [
 \"appendlist\",
]

[[package]]
name = \"test\"
version = \"25.2.0\"\n" port)))
    (mock
     ((guix scripts download) guix-download
      (lambda _
        (format #t "~a~%~a~%"
                "/gnu/store/in056fyrz6nvy3jpxrxglgj30g0lwniv-smithay-0cd3345"
                "191h87bpzg0l1ihfb4hmx00b86pfb5mwwc6s8i49al0vigc14l37")))
     (let-values
         (((source-expressions cargo-inputs-entry)
           (cargo-lock->expressions temp-file "test")))
       (and
        (match source-expressions
          (`((define rust-adler2-2.0.0
               (crate-source
                "adler2" "2.0.0"
                "09r6drylvgy8vv8k20lnbvwq8gp09h7smfn6h1rxsy15pgh629si"))
             (define rust-aho-corasick-1.1.3
               (crate-source
                "aho-corasick" "1.1.3"
                "05mrpkvdgp5d20y2p989f187ry9diliijgwrs254fs9s1m1x6q4f"))
             (define rust-smithay-0.4.0.0cd3345
               ,($ <comment>
                   ";; TODO: Define standalone package if this is a workspace.\n"
                   #f)
               (origin
                 (method git-fetch)
                 (uri (git-reference
                       (url "https://github.com/Smithay/smithay.git")
                       (commit "0cd3345c59f7cb139521f267956a1a4e33248393")))
                 (file-name (git-file-name "rust-smithay" "0.4.0.0cd3345"))
                 (sha256
                  (base32
                   "191h87bpzg0l1ihfb4hmx00b86pfb5mwwc6s8i49al0vigc14l37")))))
           #t)
          (x
           (pk 'fail (pretty-print-with-comments (current-output-port) x) #f)))
        (match cargo-inputs-entry
          (`(test => (list rust-adler2-2.0.0
                           rust-aho-corasick-1.1.3
                           rust-smithay-0.4.0.0cd3345))
           #t)
          (x
           (pk 'fail x #f))))))))

(test-end "crate")

(false-if-exception (delete-file temp-file))