[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/09: swh: Correctly handle visits without a snapshot.
From: |
guix-commits |
Subject: |
02/09: swh: Correctly handle visits without a snapshot. |
Date: |
Wed, 28 Aug 2019 12:53:11 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 8146c48632d39670afa7a8ec08a8891cc78d2b38
Author: Ludovic Courtès <address@hidden>
Date: Wed Aug 28 11:31:18 2019 +0200
swh: Correctly handle visits without a snapshot.
As discussed at
<https://sympa.inria.fr/sympa/arc/swh-devel/2019-08/msg00016.html>.
* guix/swh.scm (string*): New procedure.
(<visit>)[snapshot-url]: Pass 'string*' as the conversion procedure.
[status]: Pass 'string->symbol' as the conversion procedure.
(visit-snapshot): Return #f when 'visit-snapshot-url' returns #f.
(lookup-origin-revision): Filter to visits for which
'visit-snapshot-url' is true.
---
guix/swh.scm | 22 +++++++++++++++-------
1 file changed, 15 insertions(+), 7 deletions(-)
diff --git a/guix/swh.scm b/guix/swh.scm
index b72d1c3..c253e21 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -190,6 +190,12 @@ Software Heritage."
(ref 10))))))
str)) ;oops!
+(define string*
+ ;; Converts "string or #nil" coming from JSON to "string or #f".
+ (match-lambda
+ ((? string? str) str)
+ ((? null?) #f)))
+
(define* (call url decode #:optional (method http-get)
#:key (false-if-404? #t))
"Invoke the endpoint at URL using METHOD. Decode the resulting JSON body
@@ -239,8 +245,8 @@ FALSE-IF-404? is true, return #f upon 404 responses."
(date visit-date "date" string->date*)
(origin visit-origin)
(url visit-url "origin_visit_url")
- (snapshot-url visit-snapshot-url "snapshot_url")
- (status visit-status)
+ (snapshot-url visit-snapshot-url "snapshot_url" string*) ;string | #f
+ (status visit-status "status" string->symbol) ;'full | 'partial | 'ongoing
(number visit-number "visit"))
;;
<https://archive.softwareheritage.org/api/1/snapshot/4334c3ed4bb208604ed780d8687fe523837f1bd1/>
@@ -378,9 +384,11 @@ FALSE-IF-404? is true, return #f upon 404 responses."
(map json->visit (vector->list (json->scm port))))))
(define (visit-snapshot visit)
- "Return the snapshot corresponding to VISIT."
- (call (swh-url (visit-snapshot-url visit))
- json->snapshot))
+ "Return the snapshot corresponding to VISIT or #f if no snapshot is
+available."
+ (and (visit-snapshot-url visit)
+ (call (swh-url (visit-snapshot-url visit))
+ json->snapshot)))
(define (branch-target branch)
"Return the target of BRANCH, either a <revision> or a <release>."
@@ -396,7 +404,7 @@ FALSE-IF-404? is true, return #f upon 404 responses."
"Return a <revision> corresponding to the given TAG for the repository
coming from URL. Example:
- (lookup-origin-release \"https://github.com/guix-mirror/guix/\" \"v0.8\")
+ (lookup-origin-revision \"https://github.com/guix-mirror/guix/\" \"v0.8\")
=> #<<revision> id: \"44941…\" …>
The information is based on the latest visit of URL available. Return #f if
@@ -404,7 +412,7 @@ URL could not be found."
(match (lookup-origin url)
(#f #f)
(origin
- (match (origin-visits origin)
+ (match (filter visit-snapshot-url (origin-visits origin))
((visit . _)
(let ((snapshot (visit-snapshot visit)))
(match (and=> (find (lambda (branch)
- branch master updated (c6deb68 -> dae950c), guix-commits, 2019/08/28
- 02/09: swh: Correctly handle visits without a snapshot.,
guix-commits <=
- 08/09: remote, ssh: Show the command exit status upon failure., guix-commits, 2019/08/28
- 04/09: gnu: Add cedille., guix-commits, 2019/08/28
- 05/09: lint: Log diagnostics with 'info', not 'warning'., guix-commits, 2019/08/28
- 06/09: diagnostics: Avoid highlighting complete messages., guix-commits, 2019/08/28
- 03/09: gnu: agda-ial: Fix install step., guix-commits, 2019/08/28
- 01/09: swh: 'swh-download' prints debugging info., guix-commits, 2019/08/28
- 09/09: deploy: Do not quote error messages., guix-commits, 2019/08/28
- 07/09: gnu: emacs-evil-owl: Update to 0.0.1-2.e8fe5b2., guix-commits, 2019/08/28