import: github: Allow updating to a specific version.
* guix/import/github.scm (latest-released-version): Add #:version argument. If version is given, try to find the respective release. (latest-releease) Rename to 'import-release', add #:version argument and pass it on to 'latest-released-version'.
This commit is contained in:
		
							parent
							
								
									6da60453e2
								
							
						
					
					
						commit
						be3f48bff0
					
				
					 1 changed files with 24 additions and 12 deletions
				
			
		| 
						 | 
				
			
			@ -249,11 +249,13 @@ Alternatively, you can wait until your rate limit is reset, or use the
 | 
			
		|||
                                           #:headers headers)))
 | 
			
		||||
                   (x x)))))))))
 | 
			
		||||
 | 
			
		||||
(define (latest-released-version url package-name)
 | 
			
		||||
(define* (latest-released-version url package-name #:key (version #f))
 | 
			
		||||
  "Return the newest released version and its tag given a string URL like
 | 
			
		||||
'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of
 | 
			
		||||
the package e.g. 'bedtools2'.  Return #f (two values) if there are no
 | 
			
		||||
releases."
 | 
			
		||||
releases.
 | 
			
		||||
 | 
			
		||||
Optionally include a VERSION string to fetch a specific version."
 | 
			
		||||
  (define (pre-release? x)
 | 
			
		||||
    (assoc-ref x "prerelease"))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -290,16 +292,25 @@ releases."
 | 
			
		|||
  (match (and=> (fetch-releases-or-tags url) vector->list)
 | 
			
		||||
    (#f (values #f #f))
 | 
			
		||||
    (json
 | 
			
		||||
     (match (sort (filter-map release->version
 | 
			
		||||
     (let ((releases (filter-map release->version
 | 
			
		||||
                                 (match (remove pre-release? json)
 | 
			
		||||
                                   (() json)         ; keep everything
 | 
			
		||||
                                (releases releases)))
 | 
			
		||||
                  (lambda (x y) (version>? (car x) (car y))))
 | 
			
		||||
                                   (releases releases)))))
 | 
			
		||||
       (match (if version
 | 
			
		||||
                  ;; Find matching release version.
 | 
			
		||||
                  (filter (match-lambda
 | 
			
		||||
                           ((candidate-version . tag)
 | 
			
		||||
                            (string=? version candidate-version)))
 | 
			
		||||
                          releases)
 | 
			
		||||
                  ;; Sort releases descending.
 | 
			
		||||
                  (sort releases
 | 
			
		||||
                        (lambda (x y) (version>? (car x) (car y)))))
 | 
			
		||||
       (((latest-version . tag) . _) (values latest-version tag))
 | 
			
		||||
       (() (values #f #f))))))
 | 
			
		||||
       (() (values #f #f)))))))
 | 
			
		||||
 | 
			
		||||
(define (latest-release pkg)
 | 
			
		||||
  "Return an <upstream-source> for the latest release of PKG."
 | 
			
		||||
(define* (import-release pkg #:key (version #f))
 | 
			
		||||
  "Return an <upstream-source> for the latest release of PKG.
 | 
			
		||||
Optionally include a VERSION string to fetch a specific version."
 | 
			
		||||
  (define (github-uri uri)
 | 
			
		||||
    (match uri
 | 
			
		||||
      ((? string? url)
 | 
			
		||||
| 
						 | 
				
			
			@ -313,7 +324,8 @@ releases."
 | 
			
		|||
         (source-uri (github-uri original-uri))
 | 
			
		||||
         (name (package-name pkg))
 | 
			
		||||
         (newest-version version-tag
 | 
			
		||||
                         (latest-released-version source-uri name)))
 | 
			
		||||
                         (latest-released-version source-uri name
 | 
			
		||||
                                                  #:version version)))
 | 
			
		||||
    (if newest-version
 | 
			
		||||
        (upstream-source
 | 
			
		||||
         (package name)
 | 
			
		||||
| 
						 | 
				
			
			@ -330,6 +342,6 @@ releases."
 | 
			
		|||
   (name 'github)
 | 
			
		||||
   (description "Updater for GitHub packages")
 | 
			
		||||
   (pred github-package?)
 | 
			
		||||
   (import latest-release)))
 | 
			
		||||
   (import import-release)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue