#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PLANET.plt - local planet proxy server
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; base.ss - planet-arg and central repository interfaces
;; yc 1/18/2010 - first version
(require scheme/contract
         net/url 
         scheme/port
         "depend.ss"
         (planet bzlib/http)
         )

#|

design of a planet proxy. 

1 - parsing of the planet module (this should be quite straight forward) 

2 - crawl/spidering of the planet package 

3 - mimic planet headers... 

4 - 

;; what are the methods we need from repository
;; 1 - ctor 
;; 2 - save an http package into repo 
;; 3 - retrieve a package from repo 

;;|#

(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))
 )