| 1 | #! /usr/bin/env racket |
| 2 | ; vim: filetype=racket |
| 3 | |
| 4 | ; TODO write |
| 5 | ; TODO caching (use cache by default, unless explicitly asked for update) |
| 6 | ; TODO timeline limits |
| 7 | ; TODO user-defined feed sets (a la twitter lists) |
| 8 | ; TODO feed set operations |
| 9 | ; TODO timeline as a result of a query (feed set op + filter expressions) |
| 10 | ; TODO named timelines |
| 11 | ; TODO CLI params |
| 12 | ; TODO config files |
| 13 | ; TODO highlight mentions |
| 14 | ; TODO filter on mentions |
| 15 | ; TODO highlight hashtags |
| 16 | ; TODO filter on hashtags |
| 17 | ; TODO hashtags as channels? initial hashtag special? |
| 18 | ; TODO query language |
| 19 | ; TODO concurrency |
| 20 | ; TODO console logger colors by level ('error) |
| 21 | ; TODO file logger ('debug) |
| 22 | |
| 23 | #lang racket |
| 24 | |
| 25 | (require racket/date) |
| 26 | |
| 27 | (require http-client) |
| 28 | (require rfc3339-old) |
| 29 | |
| 30 | (struct msg (tm_epoch tm_rfc3339 nick text)) |
| 31 | (struct feed (nick uri)) |
| 32 | |
| 33 | (define (msg-print odd m) |
| 34 | (printf "~a \033[1;37m<~a>\033[0m \033[0;~am~a\033[0m~n" |
| 35 | (date->string (seconds->date [msg-tm_epoch m]) #t) |
| 36 | [msg-nick m] |
| 37 | [if odd 36 33] |
| 38 | [msg-text m])) |
| 39 | |
| 40 | (define re-msg-begin |
| 41 | ; TODO Zulu offset. Maybe in several formats. Which ones? |
| 42 | (pregexp "^[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}")) |
| 43 | |
| 44 | (define (str->msg nick str) |
| 45 | (if (not (regexp-match? re-msg-begin str)) |
| 46 | (begin |
| 47 | (log-debug "Non-msg line from nick:~a, line:~a" nick str) |
| 48 | #f) |
| 49 | (let ([toks (string-split str (regexp "\t+"))]) |
| 50 | (if (not (= 2 (length toks))) |
| 51 | (begin |
| 52 | (log-warning "Invalid msg line from nick:~a, msg:~a" nick str) |
| 53 | #f) |
| 54 | (let* |
| 55 | ([tm_rfc3339 (list-ref toks 0)] |
| 56 | [tok_text (list-ref toks 1)] |
| 57 | [t (string->rfc3339-record tm_rfc3339)] |
| 58 | ; TODO handle tz offset |
| 59 | [tm_epoch (find-seconds [rfc3339-record:second t] |
| 60 | [rfc3339-record:minute t] |
| 61 | [rfc3339-record:hour t] |
| 62 | [rfc3339-record:mday t] |
| 63 | [rfc3339-record:month t] |
| 64 | [rfc3339-record:year t])]) |
| 65 | (msg tm_epoch tm_rfc3339 nick tok_text)))))) |
| 66 | |
| 67 | (define (str->lines str) |
| 68 | (string-split str (regexp "[\r\n]+"))) |
| 69 | |
| 70 | (define (str->msgs nick str) |
| 71 | (filter-map (λ (line) (str->msg nick line)) (str->lines str))) |
| 72 | |
| 73 | (define (uri-fetch uri) |
| 74 | (log-info "GET ~a" uri) |
| 75 | (define resp (http-get uri)) |
| 76 | (define status (http-response-code resp)) |
| 77 | (define body (http-response-body resp)) |
| 78 | (log-debug "finished GET ~a status:~a body length:~a" |
| 79 | uri status (string-length body)) |
| 80 | ; TODO Handle redirects |
| 81 | (if (= status 200) body (raise status))) |
| 82 | |
| 83 | (define (timeline-print timeline) |
| 84 | (for ([msg timeline] |
| 85 | [i (in-naturals)]) |
| 86 | (msg-print (odd? i) msg))) |
| 87 | |
| 88 | (define (feed->msgs feed) |
| 89 | (log-info "downloading feed nick:~a uri:~a" |
| 90 | (feed-nick feed) |
| 91 | (feed-uri feed)) |
| 92 | (with-handlers |
| 93 | ([exn:fail:network? |
| 94 | (λ (e) |
| 95 | (log-error "network error nick:~a uri:~a exn:~a" |
| 96 | (feed-nick feed) |
| 97 | (feed-uri feed) |
| 98 | e) |
| 99 | #f)] |
| 100 | [integer? |
| 101 | (λ (status) |
| 102 | (log-error "http error nick:~a uri:~a status:~a" |
| 103 | (feed-nick feed) |
| 104 | (feed-uri feed) |
| 105 | status) |
| 106 | #f)]) |
| 107 | (str->msgs [feed-nick feed] [uri-fetch (feed-uri feed)]))) |
| 108 | |
| 109 | ; TODO timeline contract : time-sorted list of messages |
| 110 | (define (timeline feeds) |
| 111 | (sort (append* (filter-map feed->msgs feeds)) |
| 112 | (λ (a b) [< (msg-tm_epoch a) (msg-tm_epoch b)]))) |
| 113 | |
| 114 | (define (we-are-twtxt) |
| 115 | (let* ([uri |
| 116 | "https://raw.githubusercontent.com/mdom/we-are-twtxt/master/we-are-twtxt.txt"] |
| 117 | [payload |
| 118 | (uri-fetch uri)] |
| 119 | [lines |
| 120 | (str->lines payload)] |
| 121 | [feeds |
| 122 | (map (λ (line) |
| 123 | ; TODO validation |
| 124 | (define toks (string-split line)) |
| 125 | (feed |
| 126 | [list-ref toks 0] |
| 127 | [list-ref toks 1])) |
| 128 | lines)]) |
| 129 | feeds)) |
| 130 | |
| 131 | (define (setup-logging) |
| 132 | (define logger (make-logger #f #f 'debug #f)) |
| 133 | (define log-chan (make-log-receiver logger 'debug)) |
| 134 | (void (thread (λ () |
| 135 | [date-display-format 'iso-8601] |
| 136 | [let loop () |
| 137 | (define data (sync log-chan)) |
| 138 | (define level (vector-ref data 0)) |
| 139 | (define msg (vector-ref data 1)) |
| 140 | (define ts (date->string (current-date) #t)) |
| 141 | (eprintf "~a [~a] ~a~n" ts level msg) |
| 142 | (loop)]))) |
| 143 | (current-logger logger)) |
| 144 | |
| 145 | (define (main) |
| 146 | (setup-logging) |
| 147 | (current-http-response-auto #f) |
| 148 | (current-http-user-agent "xandkar/tt 0.0.0") |
| 149 | (date-display-format 'rfc2822) |
| 150 | |
| 151 | (define feeds (we-are-twtxt)) |
| 152 | (timeline-print (timeline feeds))) |
| 153 | |
| 154 | (main) |