You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
98 lines
3.0 KiB
Racket
98 lines
3.0 KiB
Racket
#lang racket/base
|
|
(require racket/date)
|
|
(require racket/string)
|
|
(require racket/format)
|
|
|
|
|
|
(provide describe report message make-datestamp make-timestamp display-stack-trace)
|
|
|
|
; todo: contracts, tests, docs
|
|
|
|
(require (prefix-in williams: (planet williams/describe/describe)))
|
|
|
|
(define (describe x)
|
|
(parameterize ([current-output-port (current-error-port)])
|
|
(williams:describe x))
|
|
x)
|
|
|
|
; debug utilities
|
|
(define months (list "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
|
|
|
|
(define last-message-time #f)
|
|
(define (seconds-since-last-message)
|
|
(define now (current-seconds))
|
|
(define then last-message-time)
|
|
(set! last-message-time now)
|
|
(if then
|
|
(- now then)
|
|
"0"))
|
|
|
|
(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)))
|
|
|
|
|
|
|
|
;; todo: consolidate these two message functions
|
|
(define (basic-message . items)
|
|
(displayln (string-join `(,@(map (λ(x)(if (string? x) x (~v x))) items))) (current-error-port)))
|
|
|
|
(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
|
|
(define-syntax-rule (report var)
|
|
(begin
|
|
(basic-message 'var "=" var)
|
|
var))
|
|
|
|
|
|
|
|
(define (exn+stack->string exn)
|
|
(string-append
|
|
(string-append "Exception: " (exn-message exn))
|
|
"\n"
|
|
"Stack:\n"
|
|
(string-join
|
|
(map (lambda (x)
|
|
(format "'~a' ~a ~a"
|
|
(if (car x) (car x) "")
|
|
(if (cdr x) (srcloc-source (cdr x)) "")
|
|
(if (cdr x) (srcloc-line (cdr x)) "")))
|
|
(continuation-mark-set->context (exn-continuation-marks exn)))
|
|
"\n")))
|
|
|
|
(define (display-stack-trace exn)
|
|
(displayln (exn+stack->string exn))) |