X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=tt;h=d1ec64c5a6b29ec899a2e6a6bdb92923fbfa767c;hb=a239a2335354d9fad0618de50987b253d07b7768;hp=46059434d82510efacb51cb1d2975da08f969e58;hpb=e5c3ae92a01b721a4f9ac27daaed6b2dfff7a060;p=tt.git

diff --git a/tt b/tt
index 4605943..d1ec64c 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 = <nick> <uri>
 ; TODO parse mentions:
 ; - @<source.nick source.url> | @<source.url>
 ; 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: <client>/<version> (+<source.url>; @<source.nick>)
-;   - requires configurability
-;   - ref: https://twtxt.readthedocs.io/en/latest/user/discoverability.html
 
 #lang racket
 
@@ -48,6 +45,43 @@
 (struct msg  (tm_epoch tm_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 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
@@ -131,26 +165,27 @@
     (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))
+(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 (str->feed str)
+  ; TODO validation
+  (define toks (string-split str))
+  (feed
+    [list-ref toks 0]
+    [list-ref toks 1]))
+
+(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 +202,30 @@
   (current-logger logger))
 
 (define (main)
+  (define user-agent
+    (let*
+      ([prog-name      "tt"]
+       [prog-version   "0.3.0"]
+       [user-feed-file (expand-user-path "~/twtxt-me.txt")]
+       [user           (list-ref (file->feeds user-feed-file) 0)])
+      (format "~a/~a (+~a; @~a)"
+              prog-name
+              prog-version
+              (feed-uri user)
+              (feed-nick 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)