X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=tt.rkt;h=8a09e4dfd4f5ef05e1ae2c97755d084f5905c875;hb=56de6228116781fbf108c6a6f68cb3436d142c57;hp=6914d7ac5bb244e13a8a9c2f8c595d53ef5bc296;hpb=78142acbc6fc969491e4cd78bda7031ef0b8a9d1;p=tt.git diff --git a/tt.rkt b/tt.rkt index 6914d7a..8a09e4d 100644 --- a/tt.rkt +++ b/tt.rkt @@ -4,6 +4,7 @@ (require racket/date) (require net/http-client + net/uri-codec net/url-string net/url-structs) @@ -36,13 +37,18 @@ [uri : Url]) #:type-name Feed) +(: tt-home-dir Path-String) +(define tt-home-dir (build-path (expand-user-path "~") ".tt")) + +(: concurrent-filter-map (∀ (α β) (-> Natural (-> α β) (Listof α)))) (define (concurrent-filter-map num-workers f xs) ; TODO preserve order of elements OR communicate that reorder is expected ; TODO switch from mailboxes to channels (define (make-worker id f) (define parent (current-thread)) (λ () - (define self (current-thread)) + (define self : Thread (current-thread)) + (: work (∀ (α) (-> α))) (define (work) (thread-send parent (cons 'next self)) (match (thread-receive) @@ -52,6 +58,7 @@ (when y (thread-send parent (cons 'result y))) (work))])) (work))) + (: dispatch (∀ (α β) (-> (Listof Nonnegative-Integer) (Listof α) (Listof β)))) (define (dispatch ws xs ys) (if (empty? ws) ys @@ -222,24 +229,33 @@ (define (str->msgs nick uri str) (filter-map (λ (line) (str->msg nick uri line)) (filter-comments (str->lines str)))) -(: hash-sha1 (-> String String)) -(define (hash-sha1 str) - (define in (open-input-string str)) - (define digest (sha1 in)) - (close-input-port in) - digest) +(: cache-dir Path-String) +(define cache-dir (build-path tt-home-dir "cache")) + +(: url->cache-file-path-v1 (-> Url Path-String)) +(define (url->cache-file-path-v1 uri) + (define (hash-sha1 str) : (-> String String) + (define in (open-input-string str)) + (define digest (sha1 in)) + (close-input-port in) + digest) + (build-path cache-dir (hash-sha1 (url->string uri)))) + +(: url->cache-file-path-v2 (-> Url Path-String)) +(define (url->cache-file-path-v2 uri) + (build-path cache-dir (uri-encode (url->string uri)))) -(: url->cache-file-path (-> Url Path-String)) -(define (url->cache-file-path uri) - ; TODO Replace hashing with encoding - (expand-user-path (string-append "~/.tt/cache/" (hash-sha1 (url->string uri))))) +(define url->cache-file-path url->cache-file-path-v2) ; TODO Return Option (: uri-read-cached (-> Url String)) (define (uri-read-cached uri) - (define path (url->cache-file-path uri)) - (if (file-exists? path) - (file->string path) + (define path-v1 (url->cache-file-path-v1 uri)) + (define path-v2 (url->cache-file-path-v2 uri)) + (when (file-exists? path-v1) + (rename-file-or-directory path-v1 path-v2 #t)) + (if (file-exists? path-v2) + (file->string path-v2) (begin (log-warning "Cache file not found for URI: ~a" (url->string uri)) ""))) @@ -309,10 +325,11 @@ (log-debug "status: ~v" status) ; TODO Handle redirects (if (= 200 status) - (call-with-output-file cache-file-path - (λ (cache-output) - (copy-port body-input cache-output)) - #:exists 'replace) + (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)])) @@ -336,17 +353,20 @@ (: feed-download (-> Feed Void)) (define (feed-download f) (match-define (feed nick uri) f) - (log-info "Downloading feed nick:~a uri:~a" nick (url->string uri)) + (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 uri 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 uri status) + (log-error "HTTP error nick:~a uri:~a status:~a" nick u status) #f)]) - (uri-download uri))) + (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) @@ -362,21 +382,29 @@ (sort (append* (filter-map feed->msgs feeds)) (λ (a b) (cmp (msg-ts-epoch a) (msg-ts-epoch b))))) -(: start-logger (-> Log-Level Void)) -(define (start-logger level) - (let* ([logger (make-logger #f #f level #f)] - [log-receiver (make-log-receiver logger level)]) - (void (thread (λ () - (parameterize - ([date-display-format 'iso-8601]) - (let loop () - (define data (sync log-receiver)) - (define level (vector-ref data 0)) - (define msg (vector-ref data 1)) - (define ts (date->string (current-date) #t)) - (eprintf "~a [~a] ~a~n" ts level msg) - (loop)))))) - (current-logger logger))) +(: 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)) (module+ main (let ([log-level 'info]) @@ -392,14 +420,17 @@ "and is one of" "r, read i : Read the timeline." "d, download : Download the timeline." + ; TODO Add path dynamically "u, upload : Upload your twtxt file (alias to execute ~/.tt/upload)." "" #:args (command . args) - (start-logger log-level) + (define log-writer (logger-start log-level)) (current-command-line-arguments (list->vector args)) (match command [(or "d" "download") - (let ([num-workers 15]) ; 15 was fastest out of the tried: 1, 5, 10, 20. + ; Initially, 15 was fastest out of the tried: 1, 5, 10, 20. Then I + ; started noticing significant slowdowns. Reducing to 5 seems to help. + (let ([num-workers 5]) (command-line #:program "tt download" @@ -408,13 +439,16 @@ njobs "Number of concurrent jobs." (set! num-workers (string->number njobs))] #:args (filename) - (timeline-download num-workers (file->feeds filename))))] + (define-values (_res _cpu real-ms _gc) + (time-apply timeline-download (list num-workers (file->feeds filename)))) + (log-info "Timeline downloaded in ~a seconds." (/ real-ms 1000.0)) + (log-writer-stop log-writer)))] [(or "u" "upload") (command-line #:program "tt upload" #:args () - (if (system (path->string (expand-user-path "~/.tt/upload"))) + (if (system (path->string (build-path tt-home-dir "upload"))) (exit 0) (exit 1)))] [(or "r" "read")