- (λ (a b) (cmp (msg-ts_epoch a) (msg-ts_epoch b)))))
-
-(define (str->feed str)
- ; TODO validation
- (define toks (string-split str))
- (apply feed toks))
-
-(define (filter-comments lines)
- (filter-not (λ (line) (string-prefix? line "#")) lines))
-
-(define (str->feeds str)
- (map str->feed (filter-comments (str->lines str))))
-
-(define (file->feeds filename)
- (str->feeds (file->string filename)))
-
-(define (user-agent prog-name prog-version)
- (let*
- ([prog-uri "https://github.com/xandkar/tt"]
- [user-feed-file (expand-user-path "~/twtxt-me.txt")]
- [user
- (if (file-exists? user-feed-file)
- (let ([user (first (file->feeds user-feed-file))])
- (format "+~a; @~a" (feed-uri user) (feed-nick user)))
- (format "+~a" prog-uri))])
- (format "~a/~a (~a)" prog-name prog-version user)))
-
-(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)))
+ (λ (a b) (cmp (msg-ts-epoch a) (msg-ts-epoch b)))))
+
+(: 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))