summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludovic.courtes@inria.fr>2019-08-28 11:31:18 +0200
committerLudovic Courtès <ludo@gnu.org>2019-08-28 18:52:51 +0200
commit8146c48632d39670afa7a8ec08a8891cc78d2b38 (patch)
tree71564d70e3fa21224d0ccc3af24d5ab2af3239ce /guix
parentb8815c5ec4ee70c535693031072447671c1b781f (diff)
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.
Diffstat (limited to 'guix')
-rw-r--r--guix/swh.scm22
1 files changed, 15 insertions, 7 deletions
diff --git a/guix/swh.scm b/guix/swh.scm
index b72d1c311e..c253e217da 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)