polling evt

gistfile1.txt

(define (poll-evt poll-thunk
                  #:interval [interval-thunk (const 1000)]
                  #:cleanup  [cleanup-thunk  void])
  (poll-guard-evt
    (lambda (polling?)
      (if polling?
          (cond [(poll-thunk) =>
                 (lambda (v)
                   (wrap-evt always-evt (const v)))]
                [else never-evt])
      (nack-guard-evt
        (lambda (nack-evt)
          (define ch (make-channel))

          (define cancel-evt
            (handle-evt nack-evt
                        (thunk* (cleanup-thunk))))

          (define (poll)
            (cond [(poll-thunk) => (lambda (v)
                                     (sync cancel-evt
                                           (channel-put-evt ch v)))]
                  [else #f]))

          (define (poller)
            (sync cancel-evt
                  (handle-evt (timer-evt (interval-thunk))
                              (thunk* (or (poll) (poller))))))
          (thread poller)
          ch))))))