Jot some thoughts on twtxt.db/block-tree thingie

[tt.git] / tt.rkt

diff --git a/tt.rkt b/tt.rkt
index b6b6bd5..01dbc6b 100644 (file)
--- a/tt.rkt
+++ b/tt.rkt
@@ -293,7 +293,7 @@
     ([prog-name      "tt"]
      [prog-version   (info:#%info-lookup 'version)]
      [prog-uri       "https://github.com/xandkar/tt"]
-     [user-feed-file (expand-user-path "~/twtxt-me.txt")]
+     [user-feed-file (build-path tt-home-dir "me")]
      [user
        (if (file-exists? user-feed-file)
            (let ([user (first (file->feeds user-feed-file))])
@@ -354,7 +354,7 @@
 (define (feed-download f)
   (match-define (feed nick uri) f)
   (define u (url->string uri))
-  (log-info "Downloading feed nick:~a uri:~a" nick u)
+  (log-info "Downloading feed uri:~a" u)
   (with-handlers
     ([exn:fail?
        (λ (e)
@@ -366,7 +366,7 @@
           #f)])
     (define-values (_result _tm-cpu-ms tm-real-ms _tm-gc-ms)
       (time-apply uri-download (list uri)))
-    (log-info "Downloaded in ~a seconds, uri: ~a" (/ tm-real-ms 1000.0) u)))
+    (log-info "Feed downloaded in ~a seconds, uri: ~a" (/ tm-real-ms 1000.0) u)))
 
 (: timeline-download (-> Integer (Listof Feed) Void))
 (define (timeline-download num-workers feeds)
@@ -382,21 +382,29 @@
   (sort (append* (filter-map feed->msgs feeds))
         (λ (a b) (cmp (msg-ts-epoch a) (msg-ts-epoch b)))))
 
-(: start-logger (-> Log-Level Void))
-(define (start-logger level)
-  (let* ([logger       (make-logger #f #f level #f)]
-         [log-receiver (make-log-receiver logger level)])
-    (void (thread (λ ()
-                     (parameterize
-                       ([date-display-format 'iso-8601])
-                       (let loop ()
-                         (define data  (sync log-receiver))
-                         (define level (vector-ref data 0))
-                         (define msg   (vector-ref data 1))
-                         (define ts    (date->string (current-date) #t))
-                         (eprintf "~a [~a] ~a~n" ts level msg)
-                         (loop))))))
-    (current-logger logger)))
+(: log-writer-stop (-> Thread Void))
+(define (log-writer-stop log-writer)
+  (log-message (current-logger) 'fatal 'stop "Exiting." #f)
+  (thread-wait log-writer))
+
+(: logger-start (-> Log-Level Thread))
+(define (logger-start level)
+  (let* ([logger
+           (make-logger #f #f level #f)]
+         [log-receiver
+           (make-log-receiver logger level)]
+         [log-writer
+           (thread
+             (λ ()
+                (parameterize
+                  ([date-display-format 'iso-8601])
+                  (let loop ()
+                    (match-define (vector level msg _ topic) (sync log-receiver))
+                    (unless (equal? topic 'stop)
+                      (eprintf "~a [~a] ~a~n" (date->string (current-date) #t) level msg)
+                      (loop))))))])
+    (current-logger logger)
+    log-writer))
 
 (module+ main
   (let ([log-level 'info])
@@ -416,7 +424,7 @@
       "u, upload   : Upload your twtxt file (alias to execute ~/.tt/upload)."
       ""
       #:args (command . args)
-      (start-logger log-level)
+      (define log-writer (logger-start log-level))
       (current-command-line-arguments (list->vector args))
       (match command
         [(or "d" "download")
@@ -431,7 +439,10 @@
               njobs "Number of concurrent jobs."
               (set! num-workers (string->number njobs))]
              #:args (filename)
-             (timeline-download num-workers (file->feeds filename))))]
+             (define-values (_res _cpu real-ms _gc)
+               (time-apply timeline-download (list num-workers (file->feeds filename))))
+             (log-info "Timeline downloaded in ~a seconds." (/ real-ms 1000.0))
+             (log-writer-stop log-writer)))]
         [(or "u" "upload")
          (command-line
            #:program