#lang racket (require racket/date) (provide defer eta-from-offset after enqueue dequeue purge-queue shutdown-queue inspect-queue today-at tomorrow-at) (define (purge items) (for ([t (in-set items)]) (kill-thread t))) (define (queue-manager-loop [items (set)]) (let ([message (thread-receive)]) (match message [(list 'add item) (queue-manager-loop (set-add items item))] [(list 'remove item) (queue-manager-loop (set-remove items item))] [(list 'inspect callback) (begin (callback items) (queue-manager-loop items))] ['purge (begin (purge items) (queue-manager-loop))] ['shutdown (purge items)]))) (define queue-manager (make-parameter (thread queue-manager-loop))) (define (enqueue t) (void? (thread-send (queue-manager) `(add ,t) #f))) (define (dequeue t) (thread-send (queue-manager) `(remove ,t) #f)) (define (inspect-queue) (thread-send (queue-manager) `(inspect ,(lambda (items) (displayln items))))) (define (purge-queue) (thread-send (queue-manager) 'purge #f)) (define (shutdown-queue) (thread-send (queue-manager) 'shutdown #f)) (define (defer fn #:eta [eta-date (current-date)]) (thread (lambda () (when (enqueue (current-thread)) (sync (alarm-evt (* 1000 (date->seconds eta-date)))) (dequeue (current-thread)) (fn))))) (define (eta-from-offset #:seconds [sec 0] #:minutes [minutes 0] #:hours [hours 0] #:days [days 0]) (seconds->date (+ (current-seconds) sec (* 60 minutes) (* 60 60 hours) (* 60 60 24 days)))) (define (set-from-base base-time hr mins) (struct-copy date base-time (hour hr) (minute mins) (second 0))) (define-syntax (after stx) (syntax-case stx (do) [(after num kw do body ...) #'(let ([eta (eta-from-offset kw num)]) (defer (lambda () body ...) #:eta eta))])) (define-syntax (tomorrow-at stx) (syntax-case stx (do) [(tomorrow-at hr mins do body ...) #'(let ([base-time (eta-from-offset #:hours 24)]) (defer (lambda () body ...) #:eta (set-from-base base-time hr mins)))])) (define-syntax (today-at stx) (syntax-case stx (do) [(today-at hr mins do body ...) #'(defer (lambda () body ...) #:eta (set-from-base (current-date) hr mins))]))