diff --git a/debug.rkt b/debug.rkt index 92c552d..8332a17 100644 --- a/debug.rkt +++ b/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 @@ -23,33 +23,46 @@ (define then last-message-time) (set! last-message-time now) (if then - (- now then) - "--")) + (- now then) + "--")) +(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-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))) + (if (<= (date-hour date) 12) + (date-hour date) ; am hours + noon hour + (modulo (date-hour date) 12)) ; pm hours after noon hour + (date-minute date) + (date-second date) + + + ))) + (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) - (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 date (current-date)) - (define date-fields (map (λ(x) (zero-fill x 2)) - (list - ; (date-day date) - ; (list-ref months (sub1 (date-month date))) - (if (<= (date-hour date) 12) - (date-hour date) ; am hours + noon hour - (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))) + (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 diff --git a/setup.rkt b/setup.rkt new file mode 100644 index 0000000..36199ad --- /dev/null +++ b/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"))) \ No newline at end of file