project-manager.ss
#lang scheme

;;; Use (make-plt) to create the archive

(require planet/util
         scheme/system
         )

; delete .bak files
; delete .svn dirs
; delete tests folder
; delete compiled folders

(define (ok) (printf "OK\n"))

(define (regexp-find-files pattern [type 'both])
  (find-files
   (λ(f)(and (or (and (equal? type 'dir) (directory-exists? f))
                 (and (equal? type 'file) (file-exists? f))
                 (equal? type 'both))
             (regexp-match 
              pattern
              (path->string f))
             f))
   (build-path ".")
   ))

(define (file-pattern->regexp pattern)
  (let* ([pattern (string-append "^" pattern "$")]
         [pattern (regexp-replace* "\\." pattern "\\\\.")]
         ;[_ (printf "p: ~s~n" pattern)]
         [pattern (regexp-replace* "\\*" pattern ".*")]
         ;[_ (printf "p: ~s~n" pattern)]
         [pattern (regexp-replace* "/" pattern "\\\\\\\\")]
         ;[_ (printf "p: ~s~n" pattern)]
         )
    pattern
    ))

(define (pattern-find-files pat [type 'both])
  (regexp-find-files 
   (file-pattern->regexp pat)
   type
   ))
  

(define (safe-delete paths)
  (printf "Are you sure you want to delete these paths (yes/no)?\n")
  (pretty-print paths)
  (newline)
  (let ([res (read-line)])
    (when (equal? res "yes")
      (printf "Deleting...")
      (map delete-directory/files paths)
      (ok)
      )))


(define (bak-files)
  (pattern-find-files "*.bak" 'file))

(define (svn-dirs)
  (pattern-find-files "*/.svn" 'dir))

(define (compiled-dirs)
  (pattern-find-files "*/compiled" 'dir))

(define (test-dirs)
  (pattern-find-files "*/test*" 'dir))

(define (clean-project)
  (safe-delete (compiled-dirs)))



;; Prepare the project to make a package.
(define (strip-project)
  (clean-project) ; remove "compiled" directories
  (safe-delete (bak-files))
  (safe-delete (test-dirs))
  (safe-delete (svn-dirs))
  )

(define (make-plt)
  (safe-delete (bak-files))
  (make-planet-archive 
   (current-directory)
   (build-path (current-directory) 'up
               "mred-designer.plt")
   ))

; (make-plt)
; then:
; (system "\"c:\\Program Files\\PLT\\planet\" fileinject orseau ..\\mred-designer.plt 3 1")
; and maybe then:
; (system "\"c:\\Program Files\\PLT\\planet\" remove orseau mred-designer.plt 3 1")