+(: uri-download (-> Url Void))
+(define (uri-download u)
+ (define cache-file-path (url->cache-file-path u))
+ (log-debug "uri-download ~v into ~v" u cache-file-path)
+ (match* ((url-scheme u) (url-host u) (url-port u))
+ [(s h p)
+ #:when (and s h)
+ (define ssl? (string=? s "https"))
+ (define-values (status-line headers body-input)
+ ; TODO Timeout. Currently hangs on slow connections.
+ (http-sendrecv
+ h
+ (url->string (struct-copy url u [scheme #f] [host #f]))
+ #:ssl? ssl?
+ #:port (cond [p p] [ssl? 443] [else 80])
+ #:headers (list (format "User-Agent: ~a" user-agent))
+ ))
+ (log-debug "headers: ~v" headers)
+ (log-debug "status-line: ~v" status-line)
+ (define status
+ (string->number (second (string-split (bytes->string/utf-8 status-line)))))
+ (log-debug "status: ~v" status)
+ ; TODO Handle redirects
+ (if (= 200 status)
+ (begin
+ (make-parent-directory* cache-file-path)
+ (call-with-output-file cache-file-path
+ (curry copy-port body-input)
+ #:exists 'replace))
+ (raise status))]
+ [(_ _ _)
+ (log-error "Invalid URI: ~v" u)]))
+
+(: timeline-print (-> Out-Format (Listof Msg) Void))
+(define (timeline-print out-format timeline)
+ (void (foldl (match-lambda**
+ [((and m (msg _ _ nick _ _)) (cons prev-nick i))
+ (let ([i (if (string=? prev-nick nick) i (+ 1 i))])
+ (msg-print out-format i m)
+ (cons nick i))])
+ (cons "" 0)
+ timeline)))
+
+(: feed->msgs (-> Feed (Listof Msg)))
+(define (feed->msgs f)
+ (match-define (feed nick uri) f)
+ (log-info "Reading feed nick:~a uri:~v" nick (url->string uri))
+ (str->msgs nick uri (uri-read-cached uri)))
+
+(: feed-download (-> Feed Void))
+(define (feed-download f)
+ (match-define (feed nick uri) f)
+ (define u (url->string uri))
+ (log-info "Downloading feed uri:~a" u)
+ (with-handlers
+ ([exn:fail?
+ (λ (e)
+ (log-error "Network error nick:~a uri:~v exn:~v" nick u e)
+ #f)]
+ [integer?
+ (λ (status)
+ (log-error "HTTP error nick:~a uri:~a status:~a" nick u status)
+ #f)])
+ (define-values (_result _tm-cpu-ms tm-real-ms _tm-gc-ms)
+ (time-apply uri-download (list uri)))
+ (log-info "Feed downloaded in ~a seconds, uri: ~a" (/ tm-real-ms 1000.0) u)))
+
+(: timeline-download (-> Integer (Listof Feed) Void))
+(define (timeline-download num-workers feeds)
+ ; TODO No need for map - can just iter
+ (void (concurrent-filter-map num-workers feed-download feeds)))
+
+; TODO timeline contract : time-sorted list of messages
+(: timeline-read (-> Timeline-Order (Listof Feed) (Listof Msg)))
+(define (timeline-read order feeds)
+ (define cmp (match order
+ ['old->new <]
+ ['new->old >]))
+ (sort (append* (filter-map feed->msgs feeds))
+ (λ (a b) (cmp (msg-ts-epoch a) (msg-ts-epoch b)))))
+
+(: log-writer-stop (-> Thread Void))
+(define (log-writer-stop log-writer)
+ (log-message (current-logger) 'fatal 'stop "Exiting." #f)
+ (thread-wait log-writer))
+
+(: logger-start (-> Log-Level Thread))
+(define (logger-start level)
+ (let* ([logger
+ (make-logger #f #f level #f)]
+ [log-receiver
+ (make-log-receiver logger level)]
+ [log-writer
+ (thread
+ (λ ()
+ (parameterize
+ ([date-display-format 'iso-8601])
+ (let loop ()
+ (match-define (vector level msg _ topic) (sync log-receiver))
+ (unless (equal? topic 'stop)
+ (eprintf "~a [~a] ~a~n" (date->string (current-date) #t) level msg)
+ (loop))))))])
+ (current-logger logger)
+ log-writer))
+