#! /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
; 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 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: <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 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)
[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)
; 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)))
-
-(define (timeline feeds)
- (let* ([timelines
- (filter-map
- (λ (feed)
- (log-info "processing feed nick:~a uri:~a"
- (feed-nick feed)
- (feed-uri feed))
- (with-handlers
- ([exn:fail:network?
- (λ (e)
- (log-error "network error nick:~a uri:~a exn:~a"
- (feed-nick feed)
- (feed-uri feed)
- e)
- #f)]
- [integer?
- (λ (status)
- (log-error "http error nick:~a uri:~a status:~a"
- (feed-nick feed)
- (feed-uri feed)
- status)
- #f)])
- (str->msgs [feed-nick feed] [uri-fetch (feed-uri feed)])))
- feeds)]
- [timeline
- (append* timelines)]
- [timeline
- (sort timeline (λ (a b) [< (msg-tm_epoch a) (msg-tm_epoch b)]))])
- timeline))
+ (msg-print out-format (odd? i) msg)))
+
+(define (feed->msgs feed)
+ (log-info "downloading feed nick:~a uri:~a"
+ (feed-nick feed)
+ (feed-uri feed))
+ (with-handlers
+ ([exn:fail:network?
+ (λ (e)
+ (log-error "network error nick:~a uri:~a exn:~a"
+ (feed-nick feed)
+ (feed-uri feed)
+ e)
+ #f)]
+ [integer?
+ (λ (status)
+ (log-error "http error nick:~a uri:~a status:~a"
+ (feed-nick feed)
+ (feed-uri feed)
+ status)
+ #f)])
+ (define uri (feed-uri feed))
+ (str->msgs [feed-nick feed] uri [uri-fetch uri])))
+
+; TODO timeline contract : time-sorted list of messages
+(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)
(let* ([uri
(str->lines payload)]
[feeds
(map (λ (line)
+ ; TODO validation
(define toks (string-split line))
(feed
[list-ref toks 0]
(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)