setup module

pull/9/head
Matthew Butterick 11 years ago
parent 58990ff485
commit a35d54727e

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

@ -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")))
Loading…
Cancel
Save