@@ -2,6 +2,7 @@
;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,6 +25,7 @@
#:use-module (guix discovery)
#:use-module ((guix download)
#:select (download-to-store url-fetch))
+ #:use-module (guix git-download)
#:use-module (guix gnupg)
#:use-module (guix packages)
#:use-module (guix diagnostics)
@@ -54,6 +56,7 @@
url-predicate
url-prefix-predicate
+ git-url-predicate
coalesce-sources
upstream-updater
@@ -185,6 +188,23 @@ MATCHING-URL?."
source URLs starts with PREFIX."
(url-predicate (cut string-prefix? prefix <>)))
+(define (git-url-predicate matching-url?)
+ "Return a predicate that returns true when passed a package whose source is
+an <origin> with the GIT-FETCH method, and one of its URLs passes
+MATCHING-URL?."
+ (lambda (package)
+ (match (package-source package)
+ ((? origin? origin)
+ (and (eq? (origin-method origin) git-fetch)
+ (match (origin-uri origin)
+ ((? git-reference? git-reference)
+ (matching-url? (git-reference-url git-reference)))
+ (((? git-reference? git-reference) ...)
+ (any matching-url? (git-reference-url git-reference)))
+ (_
+ #f))))
+ (_ #f))))
+
(define (upstream-source-archive-types release)
"Return the available types of archives for RELEASE---a list of strings such
as \"gz\" or \"xz\"."