X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=tt;h=32606b84b0840ac0a694347f3fbfcea0ddc932a2;hb=93ebe03e20275354c3c4111e5d77c74eca8a7166;hp=e8f101062b90c3de4e0fef3365951528f6923d5f;hpb=cdeef19ac448a1503f04ed3765dd88e37b427920;p=tt.git diff --git a/tt b/tt index e8f1010..32606b8 100755 --- a/tt +++ b/tt @@ -1,6 +1,42 @@ #! /usr/bin/env racket ; vim: filetype=racket +; 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 timeline as a result of a query (feed set op + filter expressions) +; TODO named timelines +; TODO CLI params +; TODO config files +; 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 (require racket/date) @@ -11,18 +47,45 @@ (struct msg (tm_epoch tm_rfc3339 nick text)) (struct feed (nick uri)) -(define (msg<-toks nick toks) - (define tm_rfc3339 (list-ref toks 0)) - (define tok_text (list-ref toks 1)) - (define t (string->rfc3339-record tm_rfc3339)) - ; TODO handle tz offset - (define tm_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 tok_text)) +(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 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) + (if (not (regexp-match? re-msg-begin str)) + (begin + (log-debug "Non-msg line from nick:~a, line:~a" nick str) + #f) + (let ([toks (string-split str (regexp "\t+"))]) + (if (not (= 2 (length toks))) + (begin + (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)] + ; TODO handle tz offset + [tm_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 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 (uri-fetch uri) (log-info "GET ~a" uri) @@ -34,78 +97,36 @@ ; TODO Handle redirects (if (= status 200) body (raise status))) -(define re-msg-begin - ; TODO Zulu offset. Maybe in several formats. Which ones? - (let ([timestamp "[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}"]) - (pregexp (string-append "^" timestamp)))) - -(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 (timeline-print timeline) (for ([msg timeline] [i (in-naturals)]) (msg-print (odd? i) msg))) -(define (str->lines str) - (string-split str (regexp "[\r\n]+"))) - -(define (str->msgs nick str) - (let* ([lines - (str->lines str)] - [msg_lines - (filter (λ (l) (regexp-match? re-msg-begin l)) lines)] - [msgs - (begin - (log-debug "nick:~a lines:~a msg_lines:~a" - nick - (length lines) - (length msg_lines)) - (filter-map - (λ (line) - (define toks (string-split line (regexp "\t+"))) - (if (= 2 (length toks)) - (msg<-toks nick toks) - (begin - (log-warning "Invalid msg from nick:~a, msg:~a" nick line) - #f)) - ) - msg_lines))]) - msgs)) - +(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)]) + (str->msgs [feed-nick feed] [uri-fetch (feed-uri feed)]))) + +; TODO timeline contract : time-sorted list of messages (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)) + (sort (append* (filter-map feed->msgs feeds)) + (λ (a b) [< (msg-tm_epoch a) (msg-tm_epoch b)]))) (define (we-are-twtxt) (let* ([uri @@ -116,6 +137,7 @@ (str->lines payload)] [feeds (map (λ (line) + ; TODO validation (define toks (string-split line)) (feed [list-ref toks 0] @@ -123,7 +145,7 @@ lines)]) feeds)) -(define (logging) +(define (setup-logging) (define logger (make-logger #f #f 'debug #f)) (define log-chan (make-log-receiver logger 'debug)) (void (thread (λ () @@ -138,11 +160,12 @@ (current-logger logger)) (define (main) - (logging) - (define feeds (we-are-twtxt)) + (setup-logging) (current-http-response-auto #f) - (current-http-user-agent "tt 0.0.0") + (current-http-user-agent "xandkar/tt 0.0.0") (date-display-format 'rfc2822) + + (define feeds (we-are-twtxt)) (timeline-print (timeline feeds))) (main)