X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=tt;h=e20cf8b30ce77405a049881f1b26eae89b17daf5;hb=895a32cff82bc984f865d2012897797bc84d4c85;hp=48ae477954f1640f55bcd9b98ca538956e1e11c5;hpb=dbccadf92230e9403a6fe6490914e3157cd733c3;p=tt.git diff --git a/tt b/tt index 48ae477..e20cf8b 100755 --- a/tt +++ b/tt @@ -1,6 +1,7 @@ #! /usr/bin/env racket ; vim: filetype=racket +; TODO optional text wrap ; TODO write ; TODO caching (use cache by default, unless explicitly asked for update) ; TODO timeline limits @@ -10,23 +11,33 @@ ; TODO named timelines ; TODO CLI params ; TODO config files +; TODO parse "following" from feed +; - following = +; TODO parse mentions: +; - @ | @ ; TODO highlight mentions ; TODO filter on mentions ; TODO highlight hashtags ; TODO filter on hashtags ; TODO hashtags as channels? initial hashtag special? ; TODO query language -; TODO concurrency ; TODO console logger colors by level ('error) ; TODO file logger ('debug) ; TODO commands: ; - r | read ; - see timeline ops above ; - w | write +; - arg or stdin ; - nick expand to URI ; - q | query ; - see timeline ops above ; - see hashtag and channels above +; - d | download +; - u | upload +; - calls user-configured command to upload user's own feed file to their server +; TODO user-agent format: / (+; @) +; - requires configurability +; - ref: https://twtxt.readthedocs.io/en/latest/user/discoverability.html #lang racket @@ -35,21 +46,62 @@ (require http-client) (require rfc3339-old) -(struct msg (tm_epoch tm_rfc3339 nick text)) +(struct msg (tm_epoch tm_rfc3339 nick uri text)) (struct feed (nick uri)) -(define (msg-print odd m) - (printf "~a \033[1;37m<~a>\033[0m \033[0;~am~a\033[0m~n" - (date->string (seconds->date [msg-tm_epoch m]) #t) - [msg-nick m] - [if odd 36 33] - [msg-text m])) +(define (concurrent-filter-map num_workers f xs) + (define (make-worker id f) + (define parent (current-thread)) + (λ () + (define self (current-thread)) + (define (work) + (thread-send parent (cons 'next self)) + (match (thread-receive) + ['done (thread-send parent (cons 'exit id))] + [(cons 'unit x) (begin + (define y (f x)) + (when y (thread-send parent (cons 'result y))) + (work))])) + (work))) + (define (dispatch ws xs ys) + (if (empty? ws) + ys + (match (thread-receive) + [(cons 'exit w) (dispatch (remove w ws =) xs ys)] + [(cons 'result y) (dispatch ws xs (cons y ys))] + [(cons 'next thd) (match xs + ['() (begin + (thread-send thd 'done) + (dispatch ws xs ys))] + [(cons x xs) (begin + (thread-send thd (cons 'unit x)) + (dispatch ws xs ys))])]))) + (define workers + (range 1 (add1 num_workers))) + (define threads + (map (λ (id) (thread (make-worker id f))) workers)) + (define results + (dispatch workers xs '())) + (for-each thread-wait threads) + results) + +(define (msg-print out-format odd msg) + (printf + (match out-format + ['single-line "~a \033[1;37m<~a ~a>\033[0m \033[0;~am~a\033[0m~n"] + ['multi-line "~a~n\033[1;37m<~a ~a>\033[0m~n\033[0;~am~a\033[0m~n~n"] + [_ (raise (format "Invalid output format: ~a" out-format))]) + (date->string (seconds->date [msg-tm_epoch msg]) #t) + (msg-nick msg) + (msg-uri msg) + (if odd 36 33) + (msg-text msg))) (define re-msg-begin ; TODO Zulu offset. Maybe in several formats. Which ones? (pregexp "^[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}")) -(define (str->msg nick str) +(define (str->msg nick uri str) (if (not (regexp-match? re-msg-begin str)) (begin (log-debug "Non-msg line from nick:~a, line:~a" nick str) @@ -70,13 +122,13 @@ [rfc3339-record:mday t] [rfc3339-record:month t] [rfc3339-record:year t])]) - (msg tm_epoch tm_rfc3339 nick tok_text)))))) + (msg tm_epoch tm_rfc3339 nick uri tok_text)))))) (define (str->lines str) (string-split str (regexp "[\r\n]+"))) -(define (str->msgs nick str) - (filter-map (λ (line) (str->msg nick line)) (str->lines str))) +(define (str->msgs nick uri str) + (filter-map (λ (line) (str->msg nick uri line)) (str->lines str))) (define (uri-fetch uri) (log-info "GET ~a" uri) @@ -88,10 +140,10 @@ ; TODO Handle redirects (if (= status 200) body (raise status))) -(define (timeline-print timeline) +(define (timeline-print out-format timeline) (for ([msg timeline] [i (in-naturals)]) - (msg-print (odd? i) msg))) + (msg-print out-format (odd? i) msg))) (define (feed->msgs feed) (log-info "downloading feed nick:~a uri:~a" @@ -112,11 +164,12 @@ (feed-uri feed) status) #f)]) - (str->msgs [feed-nick feed] [uri-fetch (feed-uri feed)]))) + (define uri (feed-uri feed)) + (str->msgs [feed-nick feed] uri [uri-fetch uri]))) ; TODO timeline contract : time-sorted list of messages -(define (timeline feeds) - (sort (append* (filter-map feed->msgs feeds)) +(define (timeline num_workers feeds) + (sort (append* (concurrent-filter-map num_workers feed->msgs feeds)) (λ (a b) [< (msg-tm_epoch a) (msg-tm_epoch b)]))) (define (we-are-twtxt) @@ -153,10 +206,12 @@ (define (main) (setup-logging) (current-http-response-auto #f) - (current-http-user-agent "xandkar/tt 0.0.0") + (current-http-user-agent "xandkar/tt 0.1.0") (date-display-format 'rfc2822) (define feeds (we-are-twtxt)) - (timeline-print (timeline feeds))) + (define out-format 'multi-line) + (define num_workers 15) ; 15 was fastest out of the tried 1, 5, 10, 15 and 20. + (timeline-print out-format (timeline num_workers feeds))) (main)