; 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 = <nick> <uri>
; TODO parse mentions:
; - @<source.nick source.url> | @<source.url>
; TODO highlight mentions
; 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:
; - d | download
; - u | upload
; - calls user-configured command to upload user's own feed file to their server
-; TODO user-agent format: <client>/<version> (+<source.url>; @<source.nick>)
-; - requires configurability
-; - ref: https://twtxt.readthedocs.io/en/latest/user/discoverability.html
#lang racket
(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)
(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]+")))
(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))
(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)
home / code / tt.git / blobdiff