ytdl.rkt

#lang racket/base

(require racket/match)

(define-logger ytdl)

(struct ytdl (thread req-ch rsp-ch))

(define (make-ytdl vid dir)
  (define args (list "--no-color" "-f" "bestaudio" "-w" "-o" (format "~a/vid.%(ext)s" dir) vid))
  (define req-ch (make-channel))
  (define rsp-ch (make-channel))
  (define t
    (thread
      (λ ()
        (define c (make-custodian)) 
        (dynamic-wind
          void
          (λ ()
            (parameterize ([current-custodian c])
              (run-download req-ch rsp-ch args)))
          (λ () (custodian-shutdown-all c))))))
  (ytdl t req-ch rsp-ch))

(define (run-download req-ch rsp-ch args)
  (define-values [subproc stdout stdin stderr]
    (apply subprocess #f #f #f "/usr/bin/youtube-dl" args))
  (define stderr-evt (read-string-evt 32 stderr))
  (define stdout-evt (read-string-evt 32 stdout))
  (define (loop progress)
    (sync (handle-evt subproc loop/exit)
          (handle-evt req-ch  loop/message)
          (handle-evt (read-string-evt 32 stderr) loop/stderr)
          (handle-evt (read-string-evt 32 stdout) loop/stdout)))
  (define (loop/message msg)
    (match msg
     ['progress (channel-put rpy-ch progress)
                (loop progress)]
     ['abort    (stop!)]))
  (define (loop/exit sp)
    (log-ytdl-info "exit")
    (subprocess-wait sp)
    (subprocess-status sp))
  (define (loop/stdout line)
    (log-ytdl-info "OUT: ~s\n" line)
    (when (eof-object? line) (set! stdout-evt never-evt))
    ;; parse out the progress here ...
    (loop progress))
  (define (loop/stderr line)
    (log-ytdl-info "ERR: ~s\n" line)
    (when (eof-object? line) (set! stderr never-evt))
    (loop progress))
  (define (stop!)
    (log-ytdl-info "sending process stop")
    (subprocess-kill subproc #t)
    (subprocess-wait subproc)
    (channel-put rsp-ch #t))
  (match (loop 0)
    [0 (void)]
    [sc (raise sc)]))

(define (ytdl-progress a-ytdl)
  (define oops-dead-evt
    (wrap-evt (thread-dead-evt (ytdl-thread a-ytdl))
              (λ (v) (error 'ytdl-progress "ytdl is dead: ~a" a-ytdl))))
  (sync oops-dead-evt
        (wrap-evt (channel-put-evt (ytdl-req-ch a-ytdl) 'progress)
                  (λ (v)
                    (sync oops-dead-evt (ytdl-rsp-ch a-ytdl))))))

;; similar for getting status and stopping