bartronx7/guix
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-01-25 03:55:08 -06:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: utils: Add function git->origin.

Browse source 
* guix/import/utils.scm: (git-origin, git->origin): Add procedures.

* guix/import/elpa.scm
(download-git-repository): Remove function download-git-repository.
(git-repository->origin): Remove function git-repository->origin.
(ref): Add function ref.
(melpa-recipe->origin): Use functions git->origin and ref.

* guix/import/go.scm
(git-checkout-hash): Remove function git-checkout-hash.
(transform-version): Add function transform-version.
(vcs->origin): Use functions git->origin and transform-version. Add
optional argument transform-version.

* tests/import/go.scm
(go-module->guix-package): Adapt test case to changes in guix/import/go.scm.

* guix/import/luanti.scm
(download-git-repository): Remove function download-git-repository.
(make-luanti-sexp): Use function git->origin.

* tests/luanti.scm
(make-package-sexp): Refresh function accordingly.

* guix/import/composer.scm
(make-php-sexp): Use function git->origin.

Change-Id: Ied05a63bdd60fbafe26fbbb4e115ff6f0bb9db3c
Signed-off-by: Liliana Marie Prikler <liliana.prikler@gmail.com>
This commit is contained in:
Nicolas Graves via Guix-patches via 2024-02-04 00:07:11 +01:00 • committed by Liliana Marie Prikler
parent 68c4eab949
commit bd2470ca4d
No known key found for this signature in database
GPG key ID: 442A84B8C70E2F87
7 changed files with 135 additions and 189 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

86
guix/import/composer.scm
View file

@ -20,25 +20,20 @@
(define-module (guix import composer)
#:use-module (ice-9 match)
#:use-module (json)
#:use-module (guix base32)
#:use-module (guix build git)
#:use-module (guix build utils)
#:use-module (guix build-system)
#:use-module (guix build-system composer)
#:use-module ((guix diagnostics) #:select (warning))
#:use-module (guix hash)
#:use-module ((guix download) #:select (download-to-store))
#:use-module (guix i18n)
#:use-module (guix import json)
#:use-module (guix import utils)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix memoization)
#:use-module (guix packages)
#:use-module (guix serialization)
#:use-module (guix store)
#:use-module (guix upstream)
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (composer->guix-package
%composer-updater
@ -135,55 +130,34 @@ COMPOSER-PACKAGE."
(dependencies (map php-package-name
(composer-package-require composer-package)))
(dev-dependencies (map php-package-name
(composer-package-dev-require composer-package)))
(git? (equal? (composer-source-type source) "git")))
((if git? call-with-temporary-directory call-with-temporary-output-file)
(lambda* (temp #:optional port)
(and (if git?
(begin
(mkdir-p temp)
(git-fetch (composer-source-url source)
(composer-source-reference source)
temp))
(url-fetch (composer-source-url source) temp))
`(package
(name ,(composer-package-name composer-package))
(version ,(composer-package-version composer-package))
(source
(origin
,@(if git?
`((method git-fetch)
(uri (git-reference
(url ,(if (string-suffix?
".git"
(composer-source-url source))
(string-drop-right
(composer-source-url source)
(string-length ".git"))
(composer-source-url source)))
(commit ,(composer-source-reference source))))
(file-name (git-file-name name version))
(sha256
(base32
,(bytevector->nix-base32-string
(file-hash* temp)))))
`((method url-fetch)
(uri ,(composer-source-url source))
(sha256 (base32 ,(guix-hash-url temp)))))))
(build-system composer-build-system)
,@(if (null? dependencies)
'()
`((inputs
(list ,@(map string->symbol dependencies)))))
,@(if (null? dev-dependencies)
'()
`((native-inputs
(list ,@(map string->symbol dev-dependencies)))))
(synopsis "")
(description ,(composer-package-description composer-package))
(home-page ,(composer-package-homepage composer-package))
(license ,(or (composer-package-license composer-package)
'unknown-license!))))))))
(composer-package-dev-require composer-package))))
`(package
(name ,(composer-package-name composer-package))
(version ,(composer-package-version composer-package))
(source
,(if (string= (composer-source-type source) "git")
(git->origin (composer-source-url source)
(const (composer-source-reference source)))
(let* ((source (composer-source-url source))
(tarball (with-store store (download-to-store store source))))
`(origin
(method url-fetch)
(uri ,source)
(sha256 (base32 ,(guix-hash-url tarball)))))))
(build-system composer-build-system)
,@(if (null? dependencies)
'()
`((inputs
(list ,@(map string->symbol dependencies)))))
,@(if (null? dev-dependencies)
'()
`((native-inputs
(list ,@(map string->symbol dev-dependencies)))))
(synopsis "")
(description ,(composer-package-description composer-package))
(home-page ,(composer-package-homepage composer-package))
(license ,(or (composer-package-license composer-package)
'unknown-license!)))))
(define composer->guix-package
(memoize

62
guix/import/elpa.scm
View file

@ -8,6 +8,7 @@
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
;;; Copyright © 2025 jgart <jgart@dismail.de>
;;;
;;; This file is part of GNU Guix.
@ -212,11 +213,6 @@ include VERSION."
url)))
(_ #f))))
(define* (download-git-repository url ref)
"Fetch the given REF from the Git repository at URL."
(with-store store
(latest-repository-commit store url #:ref ref)))
(define (package-name->melpa-recipe package-name)
"Fetch the MELPA recipe for PACKAGE-NAME, represented as an alist from
keywords to values."
@ -236,46 +232,34 @@ keywords to values."
(close-port port)
(data->recipe (cons ':name data))))
(define (git-repository->origin recipe url)
"Fetch origin details from the Git repository at URL for the provided MELPA
RECIPE."
(define ref
(cond
((assoc-ref recipe #:branch)
=> (lambda (branch) (cons 'branch branch)))
((assoc-ref recipe #:commit)
=> (lambda (commit) (cons 'commit commit)))
(else
'())))
(let-values (((directory commit) (download-git-repository url ref)))
`(origin
(method git-fetch)
(uri (git-reference
(url ,url)
(commit ,commit)))
(file-name (git-file-name name version))
(sha256
(base32
,(bytevector->nix-base32-string
(file-hash* directory #:recursive? #true)))))))
(define (ref recipe)
"Create REF from MELPA RECIPE."
(cond
((assoc-ref recipe #:branch)
=> (lambda (branch) (cons 'branch branch)))
((assoc-ref recipe #:commit)
=> (lambda (commit) (cons 'commit commit)))
(else
'())))
(define* (melpa-recipe->origin recipe)
"Fetch origin details from the MELPA recipe and associated repository for
the package named PACKAGE-NAME."
(define (github-repo->url repo)
(string-append "https://github.com/" repo ".git"))
(define (gitlab-repo->url repo)
(string-append "https://gitlab.com/" repo ".git"))
(define (recipe->origin url)
(git->origin url (const #f) #:ref (ref recipe)))
(match (assq-ref recipe ':fetcher)
('github (git-repository->origin recipe (github-repo->url (assq-ref recipe ':repo))))
('gitlab (git-repository->origin recipe (gitlab-repo->url (assq-ref recipe ':repo))))
('git (git-repository->origin recipe (assq-ref recipe ':url)))
(#f #f) ; if we're not using melpa then this stops us printing a warning
(_ (warning (G_ "unsupported MELPA fetcher: ~a, falling back to unstable MELPA source~%")
(assq-ref recipe ':fetcher))
#f)))
('github (recipe->origin
(string-append "https://github.com/" (assq-ref recipe ':repo))))
('gitlab (recipe->origin
(string-append "https://gitlab.com/" (assq-ref recipe ':repo))))
('git (recipe->origin (assq-ref recipe ':repo)))
;; XXX: if we're not using melpa then this stops us printing a warning
(#f #f)
(_ (warning (G_ "\
unsupported MELPA fetcher: ~a, falling back to unstable MELPA source~%")
(assq-ref recipe ':fetcher))
#f)))
(define (elpa-dependency->upstream-input dependency)
"Convert DEPENDENCY, an sexp as returned by 'elpa-package-inputs', into an

77
guix/import/go.scm
View file

@ -8,6 +8,7 @@
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2021, 2024 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
;;; Copyright © 2024 Christina O'Donnell <cdo@mutix.org>
;;;
;;; This file is part of GNU Guix.
@ -549,65 +550,33 @@ source."
goproxy
(module-meta-repo-root meta-data)))
(define* (git-checkout-hash url reference algorithm)
"Return the ALGORITHM hash of the checkout of URL at REFERENCE, a commit or
tag."
(define cache
(string-append (or (getenv "TMPDIR") "/tmp")
"/guix-import-go-"
(passwd:name (getpwuid (getuid)))))
;; Use a custom cache to avoid cluttering the default one under
;; ~/.cache/guix, but choose one under /tmp so that it's persistent across
;; subsequent "guix import" invocations.
(mkdir-p cache)
(chmod cache #o700)
(let-values (((checkout commit _)
(parameterize ((%repository-cache-directory cache))
(catch 'git-error
(lambda ()
(update-cached-checkout url
#:ref
`(tag-or-commit . ,reference)))
(lambda (key err)
(warning (G_ "failed to check out ~s from Git repository at '~a': ~a~%")
reference url (git-error-message err))
(values #f #f #f))))))
(if (and checkout commit)
(file-hash* checkout #:algorithm algorithm #:recursive? #true)
(nix-base32-string->bytevector
"0000000000000000000000000000000000000000000000000000"))))
(define (vcs->origin vcs-type vcs-repo-url version subdir)
"Generate the `origin' block of a package depending on what type of source
control system is being used."
control system is being used. Optionally use the function TRANSFORM-VERSION
which takes version as an input."
(case vcs-type
((git)
(let* ((plain-version? (string=? version (go-version->git-ref version
#:subdir subdir)))
;; XXX: The version field of the package, which the generated quoted
;; expression refers to, has been stripped of any 'v' prefixed.
(let* ((git-ref (go-version->git-ref version #:subdir subdir))
(plain-version? (string=? version git-ref))
(v-prefixed? (string-prefix? "v" version))
;; This is done because the version field of the package,
;; which the generated quoted expression refers to, has been
;; stripped of any 'v' prefixed.
(version-expr (if (and plain-version? v-prefixed?)
'(string-append "v" version)
`(go-version->git-ref version
,@(if subdir `(#:subdir ,subdir) '())))))
`(origin
(method git-fetch)
(uri (git-reference
(url ,vcs-repo-url)
;; This is done because the version field of the package,
;; which the generated quoted expression refers to, has been
;; stripped of any 'v' prefixed.
(commit ,version-expr)))
(file-name (git-file-name name version))
(sha256
(base32
,(bytevector->nix-base32-string
(git-checkout-hash vcs-repo-url (go-version->git-ref version
#:subdir subdir)
(hash-algorithm sha256))))))))
(pure-version (if v-prefixed?
(string-drop version 1)
version)))
(if (and plain-version? v-prefixed?)
(git->origin vcs-repo-url
(peekable-lambda (version)
(string-append "v" version))
pure-version)
(git->origin vcs-repo-url
(if subdir
(peekable-lambda (version subdir)
(go-version->git-ref version #:subdir subdir))
(peekable-lambda (version subdir)
(go-version->git-ref version)))
pure-version
subdir))))
((hg)
`(origin
(method hg-fetch)

27
guix/import/luanti.scm
View file

@ -33,7 +33,6 @@
#:use-module (guix import utils)
#:use-module (guix import json)
#:use-module (json)
#:use-module (guix base32)
#:use-module (guix git)
#:use-module ((guix git-download) #:prefix download:)
#:use-module (guix hash)
@ -278,12 +277,6 @@ results. The return value is a list of <package-keys> records."
;; XXX copied from (guix import elpa)
(define* (download-git-repository url ref)
"Fetch the given REF from the Git repository at URL."
(with-store store
(latest-repository-commit store url #:ref ref)))
(define (make-luanti-sexp author/name version repository commit
inputs home-page synopsis
description media-license license)
@ -293,25 +286,7 @@ MEDIA-LICENSE and LICENSE."
`(package
(name ,(contentdb->package-name author/name))
(version ,version)
(source
(origin
(method git-fetch)
(uri (git-reference
(url ,repository)
(commit ,commit)))
(sha256
(base32
;; The git commit is not always available.
,(and commit
(bytevector->nix-base32-string
(file-hash*
(download-git-repository repository
`(commit . ,commit))
;; 'download-git-repository' already filtered out the '.git'
;; directory.
#:select? (const #true)
#:recursive? #true)))))
(file-name (git-file-name name version))))
(source ,(git->origin repository (const #f)))
(build-system luanti-mod-build-system)
,@(maybe-propagated-inputs (map contentdb->package-name inputs))
(home-page ,home-page)

47
guix/import/utils.scm
View file

@ -13,8 +13,8 @@
;;; Copyright © 2022 Alice Brenon <alice.brenon@ens-lyon.fr>
;;; Copyright © 2022 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
;;; Copyright © 2023, 2025 Nicolas Graves <ngraves@ngraves.fr>
;;; Copyright © 2025 Cayetano Santos <csantosb@inventati.org>
;;; Copyright © 2025 Nicolas Graves <ngraves@ngraves.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -42,6 +42,8 @@
#:use-module (guix deprecation)
#:use-module (guix discovery)
#:use-module (guix build-system)
#:use-module (guix git)
#:use-module (guix hash)
#:use-module ((guix i18n) #:select (G_))
#:use-module (guix store)
#:use-module (guix download)
@ -70,6 +72,10 @@
peekable-lambda
peek-body
download-git-repository
git-origin
git->origin
package-names->package-inputs
maybe-inputs
maybe-native-inputs
@ -177,6 +183,45 @@ thrown."
(define (peek-body proc)
(procedure-property proc 'body))
(define (download-git-repository url ref)
"Fetch the given REF from the Git repository at URL. Return three values :
the commit hash, the downloaded directory and its content hash."
(with-store store
(let (((values checkout commit-hash)
(latest-repository-commit store url #:ref ref)))
(values commit-hash
checkout
(bytevector->nix-base32-string
(query-path-hash store checkout))))))
(define (git-origin url commit hash)
"Simple helper to generate a Git origin s-expression."
`(origin
(method git-fetch)
(uri (git-reference
(url ,(and (not (eq? url 'null)) url))
(commit ,commit)))
(file-name (git-file-name name version))
(sha256
(base32 ,hash))))
(define* (git->origin url proc #:key ref #:rest rest)
"Return a generated `origin' block of a package depending on the Git version
control system, and the directory in the store where the package has been
downloaded, in case further processing is necessary.
Unless overwritten with REF, the ref (as defined by the (guix git) module)
is calculated from the evaluation of PROC with trailing arguments. PROC must
be a procedure with a 'body property, used to generate the origin sexp."
(let* ((args (strip-keyword-arguments '(#:ref) rest))
(commit (apply proc args))
(ref (or ref (and commit `(tag-or-commit . ,commit))))
(_ directory hash
(if (or ref commit)
(download-git-repository url ref)
(values #f #f #f))))
(values (git-origin url (peek-body proc) hash) directory)))
(define %spdx-license-identifiers
;; https://spdx.org/licenses/
;; The gfl1.0, nmap, repoze

17
tests/go.scm
View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 François Joulaud <francois.joulaud@radiofrance.com>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -24,7 +25,7 @@
#:use-module (guix base32)
#:use-module (guix build-system go)
#:use-module (guix import go)
#:use-module (guix base32)
#:use-module (guix import utils)
#:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module (guix tests)
#:use-module (ice-9 match)
@ -407,13 +408,11 @@ package.")
(mock-http-get fixtures-go-check-test))
(mock ((guix http-client) http-fetch
(mock-http-fetch fixtures-go-check-test))
(mock ((guix git) update-cached-checkout
(lambda* (url #:key ref)
;; Return an empty directory and its hash.
(values checkout
(nix-base32-string->bytevector
"0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")
#f)))
(go-module->guix-package* "github.com/go-check/check")))))))
(mock ((guix import utils) git->origin
;; Mock an empty directory by replacing hash.
(lambda* (url proc #:key ref #:rest args)
(git-origin url (peek-body proc) "\
0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")))
(go-module->guix-package* "github.com/go-check/check")))))))
(test-end "go")

8
tests/luanti.scm
View file

@ -61,11 +61,11 @@
(origin
(method git-fetch)
(uri (git-reference
(url ,(and (not (eq? repo 'null)) repo))
(commit #f)))
(url ,(and (not (eq? repo 'null)) repo))
(commit #f)))
(file-name (git-file-name name version))
(sha256
(base32 #f))
(file-name (git-file-name name version))))
(base32 #f))))
(build-system luanti-mod-build-system)
,@(maybe-propagated-inputs inputs)
(home-page ,home-page)