From 7c36e6f49af103f16d16f3373691f7117b3b9c69 Mon Sep 17 00:00:00 2001
From: Ray Miller <ray@metail.co.uk>
Date: Mon, 6 May 2024 19:51:59 +0100
Subject: [PATCH] Replace object-oriented impl with struct

---
 gitlab.rkt | 80 ++++++++++++++++++++++++++++++++----------------------
 1 file changed, 47 insertions(+), 33 deletions(-)

diff --git a/gitlab.rkt b/gitlab.rkt
index 1e0f52b..bb0e7a0 100644
--- a/gitlab.rkt
+++ b/gitlab.rkt
@@ -1,46 +1,60 @@
 #lang racket
 
-(require net/url)
-(require (prefix-in http: net/http-easy))
-(require (only-in srfi/1 alist-cons))
+(require net/url
+         (prefix-in http: net/http-easy)
+         (only-in srfi/1 alist-cons))
 
-(provide gitlab-client%)
+(provide make-client
+         api-url
+         get
+         get-paged
+         list-descendant-groups
+         list-group-projects
+         list-groups)
+
+(struct client (url token))
 
 (define (gitlab-token-auth token)
   (lambda (uri headers params)
     (values (hash-set headers 'private-token token) params)))
 
-(define gitlab-client%
-  (class object%
-    
-    (super-new)
-    
-    (init-field token
-                (api-url (string->url "https://gitlab.com")))
-    
-    (define/public (url-for path-parts #:query [query-params '()])
-      (struct-copy url api-url
-               [query query-params]
-               [path (map (lambda (p) (path/param p '())) (append (list "api" "v4") path-parts))]))
+(define (make-client #:url (url (string->url "https://gitlab.com")) #:token token)
+  (client url token))
 
-    (define/public (get path-parts #:query [query-params '()])
-      (let* ([u (url-for path-parts #:query query-params)]
-             [res (http:get u #:auth (gitlab-token-auth token))])
-        (if (> (http:response-status-code res) 299)
-            (raise-user-error 'gitlab-client/get (format "GET ~a: ~a" (url->string u) (http:response-status-message res)))
+(define (api-url c path-parts (query-params '()))
+  (struct-copy url
+               (client-url c)
+               (query query-params)
+               (path (map (lambda (p) (path/param p '())) (append (list "api" "v4") path-parts)))))
+
+(define (get c path-parts (query-params '()))
+  (let* ((u (api-url c path-parts query-params))
+         (res (http:get u #:auth (gitlab-token-auth (client-token c)))))
+    (if (>= (http:response-status-code res) 300)
+        (raise-user-error 'gitlab/get (format "GET ~a: ~a" (url->string u) (http:response-status-message res)))
         res)))
 
-    (define/public (get-paged path-parts #:query [query-params '((per_page . "100"))])
-      (define (get-pages response accum)
-        (let ([accum (append accum (http:response-json response))]
-          [next-page (bytes->string/utf-8 (http:response-headers-ref response 'x-next-page))])
-          (if (non-empty-string? next-page)
-              (get-pages (get path-parts #:query (alist-cons 'page next-page query-params)) accum)
-              accum)))
-      (get-pages (get path-parts #:query query-params) '()))
+(define (ensure-per-page params page-size)
+  (if (assoc 'per_page params)
+      params
+      (alist-cons 'per_page page-size params)))
 
-    (define/public (list-descendant-groups group-id)
-      (get-paged (list "groups" group-id "descendant_groups")))
+(define (get-paged c path-parts (query-params '()))
+  (let ((query-parms (ensure-per-page query-params "100")))
+    (define (get-pages response accum)
+      (let ((accum (append accum (http:response-json response)))
+            (next-page (bytes->string/utf-8 (http:response-headers-ref response 'x-next-page))))
+        (if (non-empty-string? next-page)
+            (get-pages (get c path-parts (alist-cons 'page next-page query-params)) accum)
+            accum)))
+    (get-pages (get c path-parts query-params) '())))
+
+(define (list-descendant-groups c group-id)
+  (get-paged c (list "groups" group-id "descendant_groups")))
+
+(define (list-group-projects c group-id)
+  (get-paged c (list "groups" group-id "projects")))
+
+(define (list-groups c (params '()))
+  (get-paged c (list "groups") params))
 
-    (define/public (list-projects group-id)
-      (get-paged (list "groups" group-id "projects")))))
\ No newline at end of file