add forum and topic browser views

README.md

@@ -1,5 +1,7 @@
 # meowbb
 
+probably out of date demo: https://asciinema.org/a/jUw0GtaIsqZdAxTDkBRAiV2L3
+
 you'll need uhhhhhhhhhhhhhh fixed libraries
 
 ```

fs.rkt

@@ -1,15 +1,24 @@
 #!/usr/bin/env racket
 #lang racket/base
 
-(require racket/file racket/match)
+(require racket/file racket/format racket/match racket/string racket/system
+         ffi/unsafe)
 (provide (struct-out user) (struct-out post)
-         list-users get-posts dfs-modtime)
+         list-users get-posts dfs-modtime sorted-level
+         *post-index*)
 
-(define *pub-path* (build-path "/pub"))
+(define *pub-path*
+  (let ([hostname (file->string "/etc/hostname")])
+    (if (string=? (string-trim hostname) "lgbt")
+      (build-path "/pub")
+      (let ([uid ((get-ffi-obj "getuid" (ffi-lib "libc" '("6" "7")) (_fun -> _int)))])
+        (displayln "using remote mount")
+        (system "gio mount sftp://unix.lgbt/pub")
+        (build-path "/run/user/" (~a uid) "gvfs/sftp:host=unix.lgbt/pub")))))
 
 ;; pseudo-node name to represent the index post at a tree level
 ;; starts with a slash because you can't put those in filenames :3
-(define *index* "/index")
+(define *post-index* "/index")
 
 ;; data definitions
 (struct user [name description path] #:transparent)
@@ -20,6 +29,7 @@
   (define users (directory-list *pub-path*))
   (for/hash ([u (in-list users)])
     (define un (path->string u))
+    (displayln un)
     (define base (build-path *pub-path* u "forum"))
     (define desc-path (build-path base "description.txt"))
     (define desc (if (file-exists? desc-path)
@@ -28,8 +38,8 @@
     (values un (user un desc base))))
 
 ;; given the (list-users) hash, fetches and organizes every post into a rose tree, with leaf nodes
-;; being tagged with *index* representing a list of posts at that level (multiple users could make
-;; the same title of post)
+;; being tagged with *post-index* representing a list of posts at that level (multiple users could
+;; make the same title of post)
 (define (get-posts users)
   (define (valid-txt? path)
     (and (not (equal? path (build-path "description.txt")))
@@ -41,14 +51,16 @@
   (define (insert-tree! fullpath p [ctx posts])
     (match fullpath
       ['()
-       (hash-update! ctx *index* (lambda (r) (cons p r)) '())]
+       (hash-update! ctx *post-index* (lambda (r) (cons p r)) '())]
       [(list fst rst ...)
        (insert-tree! rst p (hash-ref! ctx fst make-hash))]))
 
   (for ([(un u) (in-hash users)] #:when (directory-exists? (user-path u)))
+    (displayln un)
     (define base (user-path u))
     (parameterize ([current-directory base])
       (for ([item (in-directory)] #:when (valid-txt? item))
+        (displayln item)
         (define timestamp (file-or-directory-modify-seconds item))
     (define parts (map path->string (explode-path (path-replace-extension item #""))))
     ;; we require that posts are at least 2 levels deep (forum name, post title)
@@ -59,21 +71,26 @@
       [_ (displayln "invalid path")]))))
   posts)
 
-; (define users (list-users))
-; (define posts (get-posts users))
-; (pretty-write posts)
-
 (define (dfs-modtime start [path '()] [modtimes (make-hash)])
   (define newest
     (for/fold ([newest 0]) ([(k v) (in-hash start)])
       (cond
-        [(equal? k *index*)
+        [(equal? k *post-index*)
          (apply max newest (map post-timestamp v))]
         [else
          (max newest (dfs-modtime v (cons k path) modtimes))])))
   (hash-set! modtimes (reverse path) newest)
   newest)
 
-; (define modtimes (make-hash))
-; (void (dfs-modtime posts '() modtimes))
-; (pretty-write modtimes)
+(define (hash-ref* h k)
+  (match k
+    ['() h]
+    [(cons f r) (hash-ref* (hash-ref h f) r)]))
+
+(define (sorted-level posts modtimes path)
+  (define level-posts
+    (for/list ([(k v) (in-hash (hash-ref* posts path))])
+      (cons k v)))
+  (map cdr
+       (sort level-posts >
+             #:key (λ (p) (hash-ref modtimes (append path (list (car p))))))))

tui.rkt

@@ -4,20 +4,33 @@
          "fs.rkt"
          "framework.rkt")
 
-(define meowbb%
+(define (timestamp->string ts)
+  (date->string (seconds->date ts #t) #t))
+
+(define meowbb-post-list%
   (class activity%
-    (init-field entries)
-    (super-new [fps 0.0])
+    (init-field posts)
+    (init-field modtimes)
+    (init-field forum)
+    (super-new)
+
+    (define sorted (sorted-level posts modtimes (list forum)))
+
+    (define entries
+      (for/list ([posts-in (in-list sorted)])
+        (define post (first (hash-ref posts-in *post-index*)))
+        (define modtime (hash-ref modtimes (cons (post-forum post) (post-path post))))
+        (list (last (post-path post)) (post-author post)
+              (timestamp->string modtime))))
 
     (define root
       (new header/footer%
-           [header (new label% [label-text "this is the header"])]
+           [header (new label% [label-text (format "meowbb : ~a" forum)])]
            [body (new scroll-pane%
                       [body (new table%
-                                 [flex-col 1]
-                                 [headers '("tag" "title" "author" "updated")]
+                                 [headers '("title" "author" "updated")]
                                  [cells entries])])]
-           [footer (new label% [label-text "this is the footer"])]))
+           [footer (new label% [label-text "[JK] navigate | [ENTER] select | [Q] quit"])]))
 
     (define/override (draw size)
       (send root draw size))
@@ -25,11 +38,43 @@
     (define/override (on-event e)
       (match e
         ["q" 'quit]
+        [_ (send root on-event e)
+           'continue]))))
+
+(define meowbb-forum-list%
+  (class activity%
+    (init-field posts)
+    (init-field modtimes)
+    (super-new)
+
+    (define forums (sort (hash-keys posts) string<?))
+    (define entries
+      (for/list ([forum (in-list forums)])
+        (list forum (timestamp->string (hash-ref modtimes (list forum))))))
+
+    (define root
+      (new header/footer%
+           [header (new label% [label-text "meowbb : forums"])]
+           [body (new scroll-pane%
+                   [body (new table%
+                              [headers '("forum" "updated")]
+                              [cells entries])])]
+           [footer (new label% [label-text "[JK] navigate | [ENTER] select | [Q] quit"])]))
+
+    (define/override (draw size)
+      (send root draw size))
+
+    (define/override (on-event e)
+      (match e
+        ["q" 'quit]
+        [(app-event _ 'selection row)
+         (define forum (list-ref forums row))
+         (new meowbb-post-list% [posts posts] [modtimes modtimes] [forum forum])]
         [_ (send root on-event e)
            'continue]))
 
     (define/override (on-deactivated)
-      (format "bye, meow"))))
+      "bye meow ~")))
 
 (module+ main
   (require ansi)
@@ -37,20 +82,12 @@
   ;; gang
   (date-display-format 'iso-8601)
 
+  (displayln "fetching users")
   (define users (list-users))
+  (displayln "fetching posts")
   (define posts (get-posts users))
+  (displayln "calculting modtimes")
   (define modtimes (make-hash))
   (void (dfs-modtime posts '() modtimes))
 
-  (define raw-entries
-    (for*/list ([(tag forum) (in-hash posts)] [(k v) (in-hash forum)])
-      (define post (first (hash-ref v "/index")))
-      (define modtime (hash-ref modtimes (list tag k)))
-      (list modtime tag (last (post-path post)) (post-author post)
-            (date->string (seconds->date modtime #t) #t))))
-
-  (define sorted-entries
-    (sort raw-entries > #:key first))
-  (define entries (map rest sorted-entries))
-
-  (run-application "MeowBB" (new meowbb% [entries entries])))
+  (run-application "MeowBB" (new meowbb-forum-list% [posts posts] [modtimes modtimes])))