#lang scheme/base
(require scheme/contract
net/url
scheme/port
"depend.ss"
(planet bzlib/http)
)
(define-struct planet-arg (path name major minor-low minor-high lang) #:prefab)
(define central-repository-url
(make-parameter (string->url
(or (getenv "BZLIB_PLT_REPO_URL")
"http://planet.plt-scheme.org/servlets/planet-servlet.ss"))))
(define (string->value s)
(call-with-input-string s read))
(define (value->string v)
(call-with-output-string
(lambda (out)
(write v out))))
(define (build-planet-arg path name
(major "#f")
(minor-low "0")
(minor-high "#f")
(lang (version)))
(apply make-planet-arg (map string->value
(list path name major minor-low minor-high lang))))
(define (url->planet-arg url)
(define (helper query)
(apply build-planet-arg
(map (lambda (key)
(assoc/cdr key query))
`(path name maj min-lo min-hi lang))))
(helper (url-query url)))
(define (planet-arg->central-repository-url arg)
(let ((url (string->url (url->string (central-repository-url)))))
(set-url-query! url `((path . ,(value->string (planet-arg-path arg)))
(name . ,(value->string (planet-arg-name arg)))
(maj . ,(value->string (planet-arg-major arg)))
(min-lo . ,(value->string (planet-arg-minor-low arg)))
(min-hi . ,(value->string (planet-arg-minor-high arg)))
(lang . ,(value->string (planet-arg-lang arg)))))
url))
(define (planet-arg->central-repository-response arg)
(http-get (planet-arg->central-repository-url arg)))
(provide/contract
(struct planet-arg ((path (listof string?))
(name string?)
(major (or/c false/c exact-positive-integer?))
(minor-low (or/c false/c exact-nonnegative-integer?))
(minor-high (or/c false/c exact-nonnegative-integer?))
(lang version?)
))
(build-planet-arg (->* (string? string?)
(string? string? string? string?)
planet-arg?))
(url->planet-arg (-> url? planet-arg?))
(planet-arg->central-repository-url (-> planet-arg? url?))
(planet-arg->central-repository-response (-> planet-arg? http-client-response?))
(central-repository-url (parameter/c url?))
(string->value (-> string? any))
)