setup is obsolete (now using raco)

setup.rkt

@@ -1,137 +0,0 @@
-#lang racket/base
-(require racket/system racket/port racket/file 
-           racket/class racket/list)
-(require "debug.rkt" sugar "world.rkt")
-
-(provide setup)
-
-(define cd (current-directory))
-(define test-mode (make-parameter #f))
-
-;; simple class for setup tasks
-(define task% 
-  (class object%
-    (init do-proc [undo-proc #f])
-    (define this-do do-proc)
-    (define this-undo undo-proc)
-    (super-new)
-    (define/public (do-task) (this-do))
-    (define/public (undo-task) (if this-undo (this-undo) (void)))))
-
-;; function for invoking method of multiple objects
-(define-syntax send-each
-  (syntax-rules ()
-    ;; invoke a method of every object in list
-    [(send-each objects do-method)
-     (for-each (λ(obj) (send obj do-method)) objects)]
-    ;; invoke a method of every object in list, but
-    ;; if error, invoke the undo method all the way backwards
-    ;; allows structured cleanup
-    [(send-each objects do-method undo-method)
-     (begin
-       (define (send-stack-inner objects-inner)
-         (if (empty? objects-inner)
-             (void)
-             (with-handlers ([exn:fail? (λ(err) 
-                                          (begin 
-                                            (send (car objects-inner) undo-method) 
-                                            (raise err)))])
-               (send (car objects-inner) do-method)
-               (send-stack-inner (cdr objects-inner)))))
-       ;; error has been handled all the way back up the stack
-       ;; so kill it here 
-       (with-handlers ([exn:fail? (λ(err) (void))])
-         (send-stack-inner objects)))]))
-
-
-
-(define (make-polcom-data racket-path)
-  (format "#! ~a
-#lang racket/base
-(require pollen/command)
-;; pollen setup run in ~a on ~a" 
-          racket-path
-          cd
-          (format "~a at ~a" (make-datestamp) (make-timestamp))))
-
-
-;; task: get confirmation
-(define (get-confirmation)
-  (message (format "Set up ~a as a pollen directory? ['y' or 'yes']" cd))
-  (define setup-confirm (->string (read)))
-  (when (not (ormap (λ(input)(equal? setup-confirm input)) (list "y" "yes")))
-    (error))
-  (message (format "Setting up ~a as a pollen directory" cd)))
-
-(define (abort-confirmation)
-  (message "Aborting setup"))
-
-(define confirm-setup
-  (new task% 
-       [do-proc get-confirmation]
-       [undo-proc abort-confirmation]))
-
-
-;; task: make polcom file
-
-(define (delete-polcom-file-if-existing)
-  (when (file-exists? world:command-file)
-    (begin
-      (message (format "Deleting existing polcom file in ~a" cd))
-      (delete-file world:command-file))))
-
-(define (save-polcom-file)
-  (define path-to-racket-exists? (> (len world:racket-path) 0)) 
-  
-  (if path-to-racket-exists?
-      (let ([polcom-data (make-polcom-data world:racket-path)])
-        (message (format "Using ~a as racket path" world:racket-path))
-        (delete-polcom-file-if-existing)
-        (message (format "Creating new polcom file in ~a" cd))
-        (if (not (test-mode))
-            (begin
-              (display-to-file polcom-data world:command-file)
-              (with-output-to-string (λ() (system (format "chmod 755 ~a" world:command-file)))))
-            (message "[test mode: file would be saved now]")))
-      (begin 
-        (message "No path to Racket binary")
-        (error))))
-
-(define (abort-polcom-file)
-  (message "Couldn't create polcom file")
-  (delete-polcom-file-if-existing))
-
-(define make-polcom
-  (new task%
-       [do-proc save-polcom-file]
-       [undo-proc abort-polcom-file]))
-
-
-;; task: report success
-
-(define (success-messages)
-  (message "Setup complete")
-  (define path-to-polcom (format "~a~a" cd world:command-file))
-  (message (format "Run '~a start' to start project server" path-to-polcom))
-  (message (format "Or run '~a help' for a list of commands" path-to-polcom))
-  (when (not (test-mode)) (exit)))
-
-(define report-success
-  (new task% 
-       [do-proc success-messages]))
-
-(define (setup)
-  (define tasks (list confirm-setup make-polcom report-success))
-  (send-each tasks do-task undo-task))
-
-
-;; better way to do this is to create separate removal tasks
-;; (that may rely on some of the same intermediate functions)
-;; so that errors can be caught on the way out too.
-;; also, remove conflicts with existing racket name
-;;(define (remove)
-;;  (send-each (reverse tasks) remove-task))
-
-(module+ main
-  (parameterize ([test-mode #t])
-    (setup)))