setup module

debug.rkt

@@ -4,7 +4,7 @@
 (require racket/format)
 
 
-(provide (all-defined-out))
+(provide describe report message make-datestamp make-timestamp)
 
 ; todo: contracts, tests, docs
 
@@ -26,17 +26,25 @@
       (- now then)
       "--"))
 
-
-(define (message . items)
-  (define (zero-fill str count)
+(define (zero-fill str count)
   (set! str (~a str))
   (if (> (string-length str) count)
       str
       (string-append (make-string (- count (string-length str)) #\0) str)))
 
-  (define (make-date-string)
+(define (make-datestamp)
   (define date (current-date))
   (define date-fields (map (λ(x) (zero-fill x 2)) 
+                           (list
+                            (date-day date)
+                            (list-ref months (sub1 (date-month date)))
+                            (date-year date)
+                            )))
+  (string-join date-fields "-"))
+
+(define (make-timestamp)  
+  (define date (current-date))
+  (define time-fields (map (λ(x) (zero-fill x 2)) 
                            (list
                             ; (date-day date)
                             ; (list-ref months (sub1 (date-month date)))
@@ -45,11 +53,16 @@
                                 (modulo (date-hour date) 12)) ; pm hours after noon hour
                             (date-minute date)
                             (date-second date)
-                              ;   (if (< (date-hour date) 12) "am" "pm")
-                              (seconds-since-last-message)
+                            
+                            
                             )))  
-    (apply format "[~a:~a:~a ~as]" date-fields))
-  (displayln (string-join `(,(make-date-string) ,@(map (λ(x)(if (string? x) x (~v x))) items))) (current-error-port)))
+  (string-append (string-join time-fields ":") (if (< (date-hour date) 12) "am" "pm")))
+
+(define (make-debug-timestamp)
+  (format "[~a ~as]" (make-timestamp) (seconds-since-last-message)))
+
+(define (message . items)
+  (displayln (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (~v x))) items))) (current-error-port)))
 
 
 ; report the current value of the variable, then return it

setup.rkt

@@ -0,0 +1,37 @@
+#lang racket/base
+(require racket/system racket/port racket/file racket/string racket/date)
+(require "debug.rkt" "readability.rkt")
+
+(provide setup)
+
+(define (make-polcom-data racket-path)
+  (format "#! ~a
+#lang racket/base
+(require pollen/command)
+; pollen setup run on ~a" 
+          (string-trim racket-path)
+          (format "~a at ~a" (make-datestamp) (make-timestamp))))
+
+(define (setup)
+  (define cd (current-directory))
+  (message (format "Setting up ~a as a pollen directory" cd))
+  
+  (define racket-path (with-output-to-string (λ() (system "which racket"))))
+  (define path-to-racket-exists? (> (len racket-path) 0)) 
+  
+  (if path-to-racket-exists?
+      (let ([polcom-data (make-polcom-data racket-path)]
+            [polcom-filename "polcom"])
+        (when (file-exists? polcom-filename)
+          (begin
+            (message (format "Deleting existing polcom file in ~a" cd))
+            (delete-file polcom-filename)))
+        (message (format "Creating new polcom file in ~a" cd))
+        (with-handlers ([exn:fail? (λ(e) (message "Couldn't write polcom file. Aborting setup"))])
+          (display-to-file polcom-data polcom-filename)
+          (with-output-to-string (λ() (system (format "chmod 755 ~a" polcom-filename))))
+          (message "Setup complete")
+          (message (format "Run './~a start' to start pollen" polcom-filename))
+          (message (format "Or run './~a help' for a list of commands" polcom-filename))
+          (exit)))
+      (message "No path to racket binary. Aborting setup")))