Update indentation

[tt.git] / tt.rkt

diff --git a/tt.rkt b/tt.rkt
index ec46623..f4c1b85 100644 (file)
--- a/tt.rkt
+++ b/tt.rkt
@@ -282,8 +282,7 @@
 (define (url->cache-lmod-path uri)
   (build-path cache-dir "lmods" (uri-encode (url->string uri))))
 
-; TODO Return Option
-(: uri-read-cached (-> Url String))
+(: uri-read-cached (-> Url (Option String)))
 (define (uri-read-cached uri)
   (define path-v1 (url->cache-file-path-v1 uri))
   (define path-v2 (url->cache-file-path-v2 uri))
@@ -293,7 +292,7 @@
       (file->string path-v2)
       (begin
         (log-warning "Cache file not found for URI: ~a" (url->string uri))
-        "")))
+        #f)))
 
 (: str->url (-> String (Option String)))
 (define (str->url s)
@@ -469,22 +468,22 @@
                (log-debug "Last-Modified <= current skipping the rest of ~v" u-str)
                #t))))
   (if (not cached?)
-    (begin
-      (log-debug
-        "Downloading the rest of ~v. ETag: ~a, Last-Modified: ~v"
-        u-str etag lmod)
-      (make-parent-directory* cached-object-path)
-      (make-parent-directory* cached-etag-path)
-      (make-parent-directory* cached-lmod-path)
-      (call-with-output-file cached-object-path
-                             (curry copy-port body-input)
-                             #:exists 'replace)
-      (when etag
-        (display-to-file etag cached-etag-path #:exists 'replace))
-      (when lmod
-        (display-to-file lmod cached-lmod-path #:exists 'replace))
-      'downloaded-new)
-    'skipped-cached))
+      (begin
+        (log-debug
+          "Downloading the rest of ~v. ETag: ~a, Last-Modified: ~v"
+          u-str etag lmod)
+        (make-parent-directory* cached-object-path)
+        (make-parent-directory* cached-etag-path)
+        (make-parent-directory* cached-lmod-path)
+        (call-with-output-file cached-object-path
+                               (curry copy-port body-input)
+                               #:exists 'replace)
+        (when etag
+          (display-to-file etag cached-etag-path #:exists 'replace))
+        (when lmod
+          (display-to-file lmod cached-lmod-path #:exists 'replace))
+        'downloaded-new)
+      'skipped-cached))
 
 (: uri-download
    (-> Positive-Float Url
@@ -566,7 +565,10 @@
 (define (peer->msgs peer)
   (match-define (Peer nick uri _) peer)
   (log-info "Reading peer nick:~v uri:~v" nick (url->string uri))
-  (str->msgs nick uri (uri-read-cached uri)))
+  (define msgs-data (uri-read-cached uri))
+  (if msgs-data
+      (str->msgs nick uri msgs-data)
+      '()))
 
 (: peer-download
    (-> Positive-Float Peer
@@ -591,15 +593,19 @@
     (concurrent-filter-map num-workers
                            (λ (p) (cons p (peer-download timeout p)))
                            peers))
-  (define ok? (match-lambda
-                [(cons _ (cons 'ok _)) #t]
-                [(cons _ (cons 'error _)) #f]))
-  (define (err? r) (not (ok? r)))
-  (define peers-ok (map car (filter ok? results)))
-  (define peers-err (map car (filter err? results)))
+  (define peers-ok
+    (filter-map (match-lambda
+                  [(cons p (cons 'ok _)) p]
+                  [(cons _ (cons 'error e)) #f])
+                results))
+  (define peers-err
+    (filter-map (match-lambda
+                  [(cons _ (cons 'ok _))
+                   #f]
+                  [(cons p (cons 'error e))
+                   (struct-copy Peer p [comment (format "~s" e)])])
+                results))
   (peers->file peers-ok (build-path tt-home-dir "peers-last-downloaded-ok"))
-  ; TODO Append error as a comment: <nick> <uri> # <error>
-  ; TODO Support inline/trailing comments in peer files
   (peers->file peers-err (build-path tt-home-dir "peers-last-downloaded-err")))
 
 (: uniq (∀ (α) (-> (Listof α) (Listof α))))
@@ -789,6 +795,8 @@
                     (build-path tt-home-dir "peers-all")]
                   [peers-mentioned-file
                     (build-path tt-home-dir "peers-mentioned")]
+                  [peers-parsed-file
+                    (build-path tt-home-dir "peers-parsed")]
                   [peers-mentioned-curr
                     (mentioned-peers-in-cache)]
                   [peers-mentioned-prev
@@ -804,8 +812,13 @@
                   [peers-discovered
                     (set-subtract peers-all (list->set peers-all-prev))]
                   [peers-all
-                    (peers-sort (set->list peers-all))])
+                    (peers-sort (set->list peers-all))]
+                  [peers-parsed
+                    (filter
+                      (λ (p) (< 0 (length (peer->msgs p))))
+                      peers-all)])
              (log-info "Known peers mentioned: ~a" (length peers-mentioned))
+             (log-info "Known peers parsed ~a" (length peers-parsed))
              (log-info "Known peers total: ~a" (length peers-all))
              (log-info "Discovered ~a new peers:~n~a"
                        (set-count peers-discovered)
@@ -815,6 +828,8 @@
                                         (set->list peers-discovered))))
              (peers->file peers-mentioned
                           peers-mentioned-file)
+             (peers->file peers-parsed
+                          peers-parsed-file)
              (peers->file peers-all
                           peers-all-file)))]
         [command