From a85a74ce6c9ff36ccd6ef50216ba8515723f3a62 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 1 Sep 2019 14:58:40 +0200
Subject: ci: Use (guix json) and adjust for Guile-JSON 3.x.

This is in part a followup to 81c3dc32244a17241d74eea9fa265edfcb326f6d.

* guix/ci.scm (<build>, <checkout>, <evaluation>): Define using
'define-json-mapping'.
(json->build, json->checkout, json->evaluation): Remove.
(queued-builds, latest-builds, latest-evaluations): Pass JSON arrays
through 'vector->list' to adjust for Guile-JSON 3.x.
(evaluations-for-commit): Fix typo to really export.
---
 guix/ci.scm | 68 ++++++++++++++++++++++++-------------------------------------
 1 file changed, 27 insertions(+), 41 deletions(-)

(limited to 'guix/ci.scm')

diff --git a/guix/ci.scm b/guix/ci.scm
index 1727297dd7..9e21996023 100644
--- a/guix/ci.scm
+++ b/guix/ci.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,9 +18,10 @@
 
 (define-module (guix ci)
   #:use-module (guix http-client)
-  #:autoload   (json parser) (json->scm)
+  #:use-module (guix json)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 match)
   #:export (build?
             build-id
             build-derivation
@@ -42,7 +43,7 @@
             queued-builds
             latest-builds
             latest-evaluations
-            evaluation-for-commit))
+            evaluations-for-commit))
 
 ;;; Commentary:
 ;;;
@@ -51,28 +52,31 @@
 ;;;
 ;;; Code:
 
-(define-record-type <build>
-  (make-build id derivation system status timestamp)
-  build?
-  (id          build-id)                          ;integer
+(define-json-mapping <build> make-build build?
+  json->build
+  (id          build-id "id")                     ;integer
   (derivation  build-derivation)                  ;string | #f
   (system      build-system)                      ;string
-  (status      build-status)                      ;integer
+  (status      build-status "buildstatus" )       ;integer
   (timestamp   build-timestamp))                  ;integer
 
-(define-record-type <checkout>
-  (make-checkout commit input)
-  checkout?
+(define-json-mapping <checkout> make-checkout checkout?
+  json->checkout
   (commit      checkout-commit)                   ;string (SHA1)
   (input       checkout-input))                   ;string (name)
 
-(define-record-type <evaluation>
-  (make-evaluation id spec complete? checkouts)
-  evaluation?
+(define-json-mapping <evaluation> make-evaluation evaluation?
+  json->evaluation
   (id          evaluation-id)                     ;integer
   (spec        evaluation-spec)                   ;string
-  (complete?   evaluation-complete?)              ;Boolean
-  (checkouts   evaluation-checkouts))             ;<checkout>*
+  (complete?   evaluation-complete? "in-progress"
+               (match-lambda
+                 (0 #t)
+                 (_ #f)))                         ;Boolean
+  (checkouts   evaluation-checkouts "checkouts"   ;<checkout>*
+               (lambda (checkouts)
+                 (map json->checkout
+                      (vector->list checkouts)))))
 
 (define %query-limit
   ;; Max number of builds requested in queries.
@@ -84,18 +88,11 @@
     (close-port port)
     json))
 
-(define (json->build json)
-  (make-build (hash-ref json "id")
-              (hash-ref json "derivation")
-              (hash-ref json "system")
-              (hash-ref json "buildstatus")
-              (hash-ref json "timestamp")))
-
 (define* (queued-builds url #:optional (limit %query-limit))
   "Return the list of queued derivations on URL."
   (let ((queue (json-fetch (string-append url "/api/queue?nr="
                                           (number->string limit)))))
-    (map json->build queue)))
+    (map json->build (vector->list queue))))
 
 (define* (latest-builds url #:optional (limit %query-limit)
                         #:key evaluation system)
@@ -114,26 +111,15 @@ string such as \"x86_64-linux\"), restrict to builds for SYSTEM."
                                            (option "system" system)))))
     ;; Note: Hydra does not provide a "derivation" field for entries in
     ;; 'latestbuilds', but Cuirass does.
-    (map json->build latest)))
-
-(define (json->checkout json)
-  (make-checkout (hash-ref json "commit")
-                 (hash-ref json "input")))
-
-(define (json->evaluation json)
-  (make-evaluation (hash-ref json "id")
-                   (hash-ref json "specification")
-                   (case (hash-ref json "in-progress")
-                     ((0) #t)
-                     (else #f))
-                   (map json->checkout (hash-ref json "checkouts"))))
+    (map json->build (vector->list latest))))
 
 (define* (latest-evaluations url #:optional (limit %query-limit))
   "Return the latest evaluations performed by the CI server at URL."
   (map json->evaluation
-       (json->scm
-        (http-fetch (string-append url "/api/evaluations?nr="
-                                   (number->string limit))))))
+       (vector->list
+        (json->scm
+         (http-fetch (string-append url "/api/evaluations?nr="
+                                    (number->string limit)))))))
 
 
 (define* (evaluations-for-commit url commit #:optional (limit %query-limit))
-- 
cgit v1.2.3