65 lines
2.1 KiB
Racket
65 lines
2.1 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/date racket/format racket/match racket/string racket/port
|
|
(rename-in "info.rkt" [#%info-lookup capy:info]))
|
|
|
|
(provide ~r/pad run-external get-date-ymd date->string/iso-8601 capybara-version)
|
|
|
|
(define capybara-version (capy:info 'version))
|
|
|
|
(define (get-date-ymd)
|
|
(define date (current-date))
|
|
(list (date-year date) (date-month date) (date-day date)))
|
|
|
|
;; (date-display-format 'iso-8601) fails to take into account the time zone offset
|
|
;; like at all
|
|
;; idk why this is
|
|
;; anyway since i don't want to just append that to the end of date->string in case in a future
|
|
;; version of racket this actually changes, this implements a "true" iso-8601 function from scratch
|
|
(define (date->string/iso-8601 d)
|
|
(match d
|
|
[(date second minute hour day month year _ _ _ time-zone-offset)
|
|
(define offset* (abs (quotient time-zone-offset 60)))
|
|
(define-values [offset-hours offset-minutes]
|
|
(quotient/remainder offset* 60))
|
|
(format "~a-~a-~aT~a:~a:~a~a~a:~a"
|
|
(~r/pad year 4)
|
|
(~r/pad month 2)
|
|
(~r/pad day 2)
|
|
(~r/pad hour 2)
|
|
(~r/pad minute 2)
|
|
(~r/pad second 2)
|
|
(if (negative? time-zone-offset) "-" "+")
|
|
(~r/pad offset-hours 2)
|
|
(~r/pad offset-minutes 2))]))
|
|
|
|
|
|
(define (~r/pad num pad-to)
|
|
(~r num #:min-width pad-to #:pad-string "0"))
|
|
|
|
(define (run-external prog input)
|
|
(printf " running external program: ~a\n" prog)
|
|
(define-values [proc out in err]
|
|
(subprocess #f #f #f prog))
|
|
(define out-val #f)
|
|
(define err-str "")
|
|
(define out-reader (thread (λ () (set! out-val (read out)))))
|
|
(define err-reader (thread (λ () (set! err-str (port->string err)))))
|
|
|
|
(write input in)
|
|
(flush-output in)
|
|
(close-output-port in)
|
|
|
|
(subprocess-wait proc)
|
|
(thread-wait out-reader)
|
|
(thread-wait err-reader)
|
|
|
|
(define err-trimmed (string-trim err-str))
|
|
(unless (string=? "" err-trimmed)
|
|
(error "child process raised error!" err-trimmed))
|
|
|
|
(unless out-val
|
|
(error "child process didn't return anything!"))
|
|
|
|
out-val)
|