(module refresh-manuals mzscheme
  (require "private/docpos.ss"
           "private/search.ss"
           "private/manuals.ss"
           "private/standard-urls.ss"
           "private/link.ss"
           (lib "plt-installer.ss" "setup")
           (lib "url.ss" "net")
           (lib "mred.ss" "mred")
           (lib "string-constant.ss" "string-constants")
           (lib "contract.ss")
           (lib "port.ss")
           (lib "thread.ss"))
  
  (provide refresh-manuals)
  
  (define sc-refreshing-manuals (string-constant plt:hd:refreshing-manuals))
  (define sc-refresh-downloading... (string-constant plt:hd:refresh-downloading...))
  (define sc-refresh-deleting... (string-constant plt:hd:refresh-deleting...))
  (define sc-refresh-installing... (string-constant plt:hd:refresh-installing...))
  (define sc-finished-installation (string-constant plt:hd:refreshing-manuals-finished))
  (define sc-clearing-cached-indicies (string-constant plt:hd:refresh-clearing-indicies))
  
  (define refresh-manuals
    (case-lambda
      [() (refresh-manuals known-docs)]
      [(docs-to-install)
       (unless (and (list? docs-to-install)
                    (andmap (lambda (x) (and (pair? x)
                                             (path? (car x))
                                             (string? (cdr x))))
                            docs-to-install))
         (error 'refresh-manuals "expected (listof (cons path string)) as argument, got ~e" docs-to-install))
       (let ([tmp-directory (find/create-temporary-docs-dir)]
             [success? #f]
             [thd #f])
         (with-installer-window
          (lambda (parent)
            (set! thd (current-thread))
            (unless tmp-directory
              (error 'plt-installer "please clean out ~a" (find-system-path 'temp-dir)))
            (let ([docs-error (download-docs docs-to-install tmp-directory)])
              (cond
                [docs-error
                 (printf "~a\n" docs-error)]
                [else
                 (delete-docs docs-to-install)
                 (install-docs docs-to-install tmp-directory parent)
                 (delete-local-plt-files tmp-directory)
                 (display sc-clearing-cached-indicies)
                 (newline)
                 
                 ;; tell the web-server to visit the url for flushing the cache
                 ;; this is necc. because the server creates a new namespace for
                 ;; each servlet, so we have to get the webserver to visit the servlet
                 ;; in order to flush the cache. We don't, however, want to actually
                 ;; visit the page, so we just do this for its effect.
                 (let-values ([(in1 out1) (make-pipe)]
                              [(in2 out2) (make-pipe)])
                   (thread (lambda () 
                             (fprintf out1 "GET ~a HTTP/1.0\r\n" flush-manuals-path)
                             (close-output-port out1)))
                   (serve-ports in1 out2) ;; spawns its own thread
                   (let loop ()
                     (let ([b (with-handlers ([exn? (lambda (x) eof)])
                                (read-byte in2))])
                       (unless (eof-object? b)
                         (loop))))
                   (close-input-port in2))])
              
              (display sc-finished-installation)
              (newline)
              (set! success? #t)))
          (lambda ()
            (unless success?
              (delete-local-plt-files tmp-directory))
            (kill-thread thd))))]))
      
  (define (make-local-doc-filename tmp-dir stub)
    (build-path tmp-dir (format "~a-doc.plt" stub)))

  ;; if cannot find a suitable directory, #f is returned
  ;; if okay, returns the path to the directory.
  (define find/create-temporary-docs-dir
    ;(-> (union string? false?))
    (lambda ()
      (let ([temp-dir (find-system-path 'temp-dir)])
        (let loop ([n 0])
          (if (= n 30)
              #f
              (let ([candidate (build-path temp-dir (format "help-refresh-docs~a" n))])
                (if (directory-exists? candidate)
                    (loop (+ n 1))
                    (begin
                      (make-directory candidate)
                      candidate))))))))
                  

      


                                                        
    ;;                       ;;;                     ;; 
     ;                         ;                      ; 
     ;                         ;                      ; 
  ;;;;   ;;;  ;;; ;;;; ;;;     ;     ;;;   ;;;;    ;;;; 
 ;   ;  ;   ;  ;   ;  ;;  ;    ;    ;   ;      ;  ;   ; 
 ;   ;  ;   ;  ; ; ;  ;   ;    ;    ;   ;   ;;;;  ;   ; 
 ;   ;  ;   ;  ; ; ;  ;   ;    ;    ;   ;  ;   ;  ;   ; 
 ;   ;  ;   ;   ; ;   ;   ;    ;    ;   ;  ;   ;  ;   ; 
  ;;; ;  ;;;    ; ;  ;;;  ;; ;;;;;;  ;;;    ;;; ;  ;;; ;
                                                        
                                                        
                                                        

  ;; download-docs : ... -> (union #f string)
  ;; downloads the docs to the tmp-dir
  (define download-docs
    (lambda (docs-to-install tmp-dir)
      (let loop ([known-docs docs-to-install])
        (cond
          [(null? known-docs) #f]
          [else (let* ([known-doc (car known-docs)]
                       [resp (download-doc tmp-dir (car known-doc) (cdr known-doc))])
                  (if (string? resp)
                      resp
                      (loop (cdr known-docs))))]))))
      
  ;; download-doc : ... -> (union #f string)
  ;; stub is the `drscheme' portion of `drscheme-doc.plt'.
  (define download-doc
    (lambda (tmp-dir stub full-name)
      (let ([url (make-docs-plt-url (path->string stub))]
            [doc-name (make-local-doc-filename tmp-dir stub)])
        (display (format sc-refresh-downloading... full-name))
        (newline)
        (call-with-output-file doc-name
          (lambda (out-port)
            (call/input-url (string->url url) 
                            get-impure-port 
                            (lambda (in-port)
                              (let/ec k
                                (let* ([resp (purify-port in-port)]
                                       [m (regexp-match #rx"HTTP/[^ ]* ([0-9]+)([^\r\n]*)" resp)])
                                  (unless m
                                    (k "malformed response from server ~s" resp))
                                  (let ([code (string->number (cadr m))])
                                    (unless (equal? code 200)
                                      (k (format "error response from server \"~a~a\"" code (caddr m)))))
                                  (copy-port in-port out-port)
                                  #f)))))))))
      
      
                                          
    ;;         ;;;                        
     ;           ;            ;           
     ;           ;            ;           
  ;;;;   ;;;     ;     ;;;   ;;;;;   ;;;  
 ;   ;  ;   ;    ;    ;   ;   ;     ;   ; 
 ;   ;  ;;;;;    ;    ;;;;;   ;     ;;;;; 
 ;   ;  ;        ;    ;       ;     ;     
 ;   ;  ;   ;    ;    ;   ;   ;   ; ;   ; 
  ;;; ;  ;;;   ;;;;;;  ;;;     ;;;   ;;;  
                                          
                                          
                                      
  (define delete-docs
    (lambda (docs)
      (for-each (lambda (known-doc) (delete-known-doc (car known-doc) (cdr known-doc)))
                docs)))
      
  (define delete-known-doc
    (lambda (doc full-name)
      (let ([doc-dir (find-doc-directory doc)])
        (when doc-dir
          (display (format sc-refresh-deleting... full-name))
          (newline)
          (delete-directory/r doc-dir)))))
      
  (define delete-local-plt-files
    (lambda (tmp-dir)
      (delete-directory/r tmp-dir)))
      
  ;; deletes the entire subtree underneath this directory
  ;; (including the dir itself)
  (define delete-directory/r 
    (lambda (dir)
      (when (directory-exists? dir)
        (let loop ([dir dir])
          (let ([children (directory-list dir)])
            (for-each (lambda (f) (when (file-exists? (build-path dir f))
                                    (delete-file (build-path dir f))))
                      children)
            (for-each (lambda (d) (when (directory-exists? (build-path dir d))
                                    (loop (build-path dir d))))
                      children)
            (delete-directory dir))))))

      
                                                 
   ;                                ;;;    ;;;   
                       ;              ;      ;   
                       ;              ;      ;   
 ;;;   ; ;;;    ;;;   ;;;;;  ;;;;     ;      ;   
   ;    ;;  ;  ;   ;   ;         ;    ;      ;   
   ;    ;   ;   ;;;    ;      ;;;;    ;      ;   
   ;    ;   ;      ;   ;     ;   ;    ;      ;   
   ;    ;   ;  ;   ;   ;   ; ;   ;    ;      ;   
 ;;;;; ;;;  ;;  ;;;     ;;;   ;;; ; ;;;;;; ;;;;;;
                                                 
                                                 
    
  (define install-docs
    (lambda (docs-to-install tmp-dir parent)
      (for-each (lambda (pr) 
                  (display (format sc-refresh-installing... (cdr pr)))
                  (newline)
                  (run-single-installer (make-local-doc-filename tmp-dir (car pr))
                                        parent))
                docs-to-install))))
