fae660b0e4
This was developed in a different repository, so the history will be archived there: https://github.com/jeapostrophe/galaxy
69 lines
2.0 KiB
Racket
69 lines
2.0 KiB
Racket
#lang racket/base
|
|
(require racket/path
|
|
racket/list
|
|
racket/function
|
|
racket/file
|
|
racket/port
|
|
racket/match
|
|
net/url
|
|
json)
|
|
|
|
(define (make-parent-directory* p)
|
|
(define parent (path-only p))
|
|
(make-directory* parent))
|
|
|
|
(define (table-display l)
|
|
(define how-many-cols (length (first l)))
|
|
(define max-widths
|
|
(for/list ([col (in-range how-many-cols)])
|
|
(apply max (map (compose string-length (curryr list-ref col)) l))))
|
|
(for ([row (in-list l)])
|
|
(for ([col (in-list row)]
|
|
[i (in-naturals 1)]
|
|
[width (in-list max-widths)])
|
|
(printf "~a~a"
|
|
col
|
|
(if (= i how-many-cols)
|
|
""
|
|
(make-string (+ (- width (string-length col)) 4) #\space))))
|
|
(printf "\n")))
|
|
|
|
(define (call/input-url+200 u fun)
|
|
#;(printf "\t\tReading ~a\n" (url->string u))
|
|
(define-values (ip hs) (get-pure-port/headers u #:redirections 25 #:status? #t))
|
|
(and (string=? "200" (substring hs 9 12))
|
|
(fun ip)))
|
|
|
|
(define (url-path/no-slash url)
|
|
(define p (url-path url))
|
|
(define rp (reverse p))
|
|
(reverse
|
|
(match rp
|
|
[(list* (path/param "" _) rest)
|
|
rest]
|
|
[_ rp])))
|
|
|
|
(define (package-url->checksum pkg-url-str)
|
|
(define pkg-url
|
|
(string->url pkg-url-str))
|
|
(match (url-scheme pkg-url)
|
|
["github"
|
|
(match-define (list* user repo branch path)
|
|
(map path/param-path (url-path/no-slash pkg-url)))
|
|
(define branches
|
|
(call/input-url+200
|
|
(url "https" #f "api.github.com" #f #t
|
|
(map (λ (x) (path/param x empty))
|
|
(list "repos" user repo "branches"))
|
|
empty
|
|
#f)
|
|
read-json))
|
|
(for/or ([b (in-list branches)])
|
|
(and (equal? (hash-ref b 'name) branch)
|
|
(hash-ref (hash-ref b 'commit) 'sha)))]
|
|
[_
|
|
(call/input-url+200 (string->url (string-append pkg-url-str ".CHECKSUM"))
|
|
port->string)]))
|
|
|
|
(provide (all-defined-out))
|