X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=tt;h=2bbe402fca4506dfc8814f7ff573c6d59549de6d;hb=9926c9a99da3d862b95da39669f767e4f020ec72;hp=46059434d82510efacb51cb1d2975da08f969e58;hpb=e5c3ae92a01b721a4f9ac27daaed6b2dfff7a060;p=tt.git diff --git a/tt b/tt index 4605943..2bbe402 100755 --- a/tt +++ b/tt @@ -5,12 +5,13 @@ ; TODO write ; TODO caching (use cache by default, unless explicitly asked for update) ; TODO timeline limits -; TODO user-defined feed sets (a la twitter lists) -; TODO feed set operations +; TODO feed set operations (perhaps better done externally?) ; TODO timeline as a result of a query (feed set op + filter expressions) ; TODO named timelines ; TODO CLI params ; TODO config files +; TODO parse "following" from feed +; - following = ; TODO parse mentions: ; - @ | @ ; TODO highlight mentions @@ -19,7 +20,6 @@ ; 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: @@ -34,9 +34,6 @@ ; - 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 @@ -45,16 +42,50 @@ (require http-client) (require rfc3339-old) -(struct msg (tm_epoch tm_rfc3339 nick uri text)) +(struct msg (ts_epoch ts_rfc3339 nick uri text)) (struct feed (nick uri)) +(define (concurrent-filter-map num_workers f xs) + ; TODO switch from mailboxes to channels + (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 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) + (date->string (seconds->date [msg-ts_epoch msg]) #t) (msg-nick msg) (msg-uri msg) (if odd 36 33) @@ -75,17 +106,17 @@ (log-warning "Invalid msg line from nick:~a, msg:~a" nick str) #f) (let* - ([tm_rfc3339 (list-ref toks 0)] - [tok_text (list-ref toks 1)] - [t (string->rfc3339-record tm_rfc3339)] + ([ts_rfc3339 (first toks)] + [text (second toks)] + [t (string->rfc3339-record ts_rfc3339)] ; TODO handle tz offset - [tm_epoch (find-seconds [rfc3339-record:second t] + [ts_epoch (find-seconds [rfc3339-record:second t] [rfc3339-record:minute t] [rfc3339-record:hour t] [rfc3339-record:mday t] [rfc3339-record:month t] [rfc3339-record:year t])]) - (msg tm_epoch tm_rfc3339 nick uri tok_text)))))) + (msg ts_epoch ts_rfc3339 nick uri text)))))) (define (str->lines str) (string-split str (regexp "[\r\n]+"))) @@ -131,26 +162,25 @@ (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)) - (λ (a b) [< (msg-tm_epoch a) (msg-tm_epoch b)]))) +(define (timeline num_workers feeds) + (sort (append* (concurrent-filter-map num_workers feed->msgs feeds)) + (λ (a b) [< (msg-ts_epoch a) (msg-ts_epoch b)]))) + +(define (str->feed str) + ; TODO validation + (define toks (string-split str)) + (apply feed toks)) + +(define (str->feeds str) + (map str->feed (str->lines str))) + +(define (file->feeds filename) + (str->feeds (file->string filename))) (define (we-are-twtxt) - (let* ([uri - "https://raw.githubusercontent.com/mdom/we-are-twtxt/master/we-are-twtxt.txt"] - [payload - (uri-fetch uri)] - [lines - (str->lines payload)] - [feeds - (map (λ (line) - ; TODO validation - (define toks (string-split line)) - (feed - [list-ref toks 0] - [list-ref toks 1])) - lines)]) - feeds)) + (define uri + "https://raw.githubusercontent.com/mdom/we-are-twtxt/master/we-are-twtxt.txt") + (str->feeds (uri-fetch uri))) (define (setup-logging) (define logger (make-logger #f #f 'debug #f)) @@ -167,13 +197,32 @@ (current-logger logger)) (define (main) + (define user-agent + (let* + ([prog-name "tt"] + [prog-version "0.3.3"] + [prog-uri "https://github.com/xandkar/tt"] + [user-feed-file (expand-user-path "~/twtxt-me.txt")] + [user + (if (file-exists? user-feed-file) + (let ([user (first (file->feeds user-feed-file))]) + (format "+~a; @~a" (feed-uri user) (feed-nick user))) + (format "+~a" prog-uri))] + ) + (format "~a/~a (~a)" prog-name prog-version user))) + (setup-logging) (current-http-response-auto #f) - (current-http-user-agent "xandkar/tt 0.0.0") + (current-http-user-agent user-agent) (date-display-format 'rfc2822) - (define feeds (we-are-twtxt)) + (define args (current-command-line-arguments)) + (define feeds + (if (vector-empty? args) + (we-are-twtxt) + (file->feeds (vector-ref args 0)))) (define out-format 'multi-line) - (timeline-print out-format (timeline feeds))) + (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)