65 lines
1.7 KiB
Racket
65 lines
1.7 KiB
Racket
#lang racket/base
|
|
(require mzlib/os
|
|
racket/contract
|
|
racket/file
|
|
racket/match)
|
|
|
|
(struct pqueue (dir))
|
|
|
|
(define (pqueue-tmp dir) (build-path dir "tmp"))
|
|
(define (pqueue-dest dir) (build-path dir "queue"))
|
|
|
|
(define pqueue-init!
|
|
(match-lambda
|
|
[(pqueue dir)
|
|
(make-directory* (pqueue-tmp dir))
|
|
(make-directory* (pqueue-dest dir))]))
|
|
|
|
(define (pqueue-enqueue! pq v)
|
|
(match-define (pqueue dir) pq)
|
|
(define uniq
|
|
(format "~a.~a"
|
|
(current-inexact-milliseconds)
|
|
(getpid)))
|
|
(define tmp (build-path (pqueue-tmp dir) uniq))
|
|
(define dest (build-path (pqueue-dest dir) uniq))
|
|
|
|
(with-output-to-file tmp
|
|
(λ () (write v)))
|
|
|
|
(rename-file-or-directory tmp dest))
|
|
|
|
(define current-pqueue-wait-seconds (make-parameter 10))
|
|
|
|
(define (pqueue-dequeue! pq)
|
|
(match-define (pqueue dir) pq)
|
|
(match (directory-list (pqueue-dest dir))
|
|
[(list-rest choice _)
|
|
(define dest
|
|
(build-path (pqueue-dest dir) choice))
|
|
(define tmp
|
|
(build-path (pqueue-tmp dir) choice))
|
|
|
|
(define succeeded?
|
|
(with-handlers ([exn? (λ (x) #f)])
|
|
(rename-file-or-directory dest tmp)
|
|
#t))
|
|
(if (not succeeded?)
|
|
(pqueue-dequeue! pq)
|
|
(dynamic-wind
|
|
void
|
|
(λ ()
|
|
(with-input-from-file tmp read))
|
|
(λ ()
|
|
(delete-file tmp))))]
|
|
[_
|
|
(sleep (current-pqueue-wait-seconds))
|
|
(pqueue-dequeue! pq)]))
|
|
|
|
(provide/contract
|
|
[current-pqueue-wait-seconds (parameter/c exact-nonnegative-integer?)]
|
|
[struct pqueue ([dir path-string?])]
|
|
[pqueue-init! (pqueue? . -> . void)]
|
|
[pqueue-enqueue! (pqueue? any/c . -> . void)]
|
|
[pqueue-dequeue! (pqueue? . -> . any/c)])
|
|
|