diff options
| author | Ludovic Courtès <ludovic.courtes@inria.fr> | 2019-08-28 11:31:18 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-08-28 18:52:51 +0200 |
| commit | 8146c48632d39670afa7a8ec08a8891cc78d2b38 (patch) | |
| tree | 71564d70e3fa21224d0ccc3af24d5ab2af3239ce /guix | |
| parent | b8815c5ec4ee70c535693031072447671c1b781f (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.scm | 22 |
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) |