add forum and topic browser views

This commit is contained in:
xenia 2021-04-04 02:33:48 -04:00
parent 8079dda52f
commit b21c80ccc9
3 changed files with 91 additions and 35 deletions

View File

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

47
fs.rkt Executable file → Normal file
View File

@ -1,15 +1,24 @@
#!/usr/bin/env racket #!/usr/bin/env racket
#lang racket/base #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) (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 ;; 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 ;; starts with a slash because you can't put those in filenames :3
(define *index* "/index") (define *post-index* "/index")
;; data definitions ;; data definitions
(struct user [name description path] #:transparent) (struct user [name description path] #:transparent)
@ -20,6 +29,7 @@
(define users (directory-list *pub-path*)) (define users (directory-list *pub-path*))
(for/hash ([u (in-list users)]) (for/hash ([u (in-list users)])
(define un (path->string u)) (define un (path->string u))
(displayln un)
(define base (build-path *pub-path* u "forum")) (define base (build-path *pub-path* u "forum"))
(define desc-path (build-path base "description.txt")) (define desc-path (build-path base "description.txt"))
(define desc (if (file-exists? desc-path) (define desc (if (file-exists? desc-path)
@ -28,8 +38,8 @@
(values un (user un desc base)))) (values un (user un desc base))))
;; given the (list-users) hash, fetches and organizes every post into a rose tree, with leaf nodes ;; 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 ;; being tagged with *post-index* representing a list of posts at that level (multiple users could
;; the same title of post) ;; make the same title of post)
(define (get-posts users) (define (get-posts users)
(define (valid-txt? path) (define (valid-txt? path)
(and (not (equal? path (build-path "description.txt"))) (and (not (equal? path (build-path "description.txt")))
@ -41,14 +51,16 @@
(define (insert-tree! fullpath p [ctx posts]) (define (insert-tree! fullpath p [ctx posts])
(match fullpath (match fullpath
['() ['()
(hash-update! ctx *index* (lambda (r) (cons p r)) '())] (hash-update! ctx *post-index* (lambda (r) (cons p r)) '())]
[(list fst rst ...) [(list fst rst ...)
(insert-tree! rst p (hash-ref! ctx fst make-hash))])) (insert-tree! rst p (hash-ref! ctx fst make-hash))]))
(for ([(un u) (in-hash users)] #:when (directory-exists? (user-path u))) (for ([(un u) (in-hash users)] #:when (directory-exists? (user-path u)))
(displayln un)
(define base (user-path u)) (define base (user-path u))
(parameterize ([current-directory base]) (parameterize ([current-directory base])
(for ([item (in-directory)] #:when (valid-txt? item)) (for ([item (in-directory)] #:when (valid-txt? item))
(displayln item)
(define timestamp (file-or-directory-modify-seconds item)) (define timestamp (file-or-directory-modify-seconds item))
(define parts (map path->string (explode-path (path-replace-extension 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) ;; we require that posts are at least 2 levels deep (forum name, post title)
@ -59,21 +71,26 @@
[_ (displayln "invalid path")])))) [_ (displayln "invalid path")]))))
posts) posts)
; (define users (list-users))
; (define posts (get-posts users))
; (pretty-write posts)
(define (dfs-modtime start [path '()] [modtimes (make-hash)]) (define (dfs-modtime start [path '()] [modtimes (make-hash)])
(define newest (define newest
(for/fold ([newest 0]) ([(k v) (in-hash start)]) (for/fold ([newest 0]) ([(k v) (in-hash start)])
(cond (cond
[(equal? k *index*) [(equal? k *post-index*)
(apply max newest (map post-timestamp v))] (apply max newest (map post-timestamp v))]
[else [else
(max newest (dfs-modtime v (cons k path) modtimes))]))) (max newest (dfs-modtime v (cons k path) modtimes))])))
(hash-set! modtimes (reverse path) newest) (hash-set! modtimes (reverse path) newest)
newest) newest)
; (define modtimes (make-hash)) (define (hash-ref* h k)
; (void (dfs-modtime posts '() modtimes)) (match k
; (pretty-write modtimes) ['() 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))))))))

77
tui.rkt
View File

@ -4,20 +4,33 @@
"fs.rkt" "fs.rkt"
"framework.rkt") "framework.rkt")
(define meowbb% (define (timestamp->string ts)
(date->string (seconds->date ts #t) #t))
(define meowbb-post-list%
(class activity% (class activity%
(init-field entries) (init-field posts)
(super-new [fps 0.0]) (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 (define root
(new header/footer% (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 scroll-pane%
[body (new table% [body (new table%
[flex-col 1] [headers '("title" "author" "updated")]
[headers '("tag" "title" "author" "updated")]
[cells entries])])] [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) (define/override (draw size)
(send root draw size)) (send root draw size))
@ -25,11 +38,43 @@
(define/override (on-event e) (define/override (on-event e)
(match e (match e
["q" 'quit] ["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) [_ (send root on-event e)
'continue])) 'continue]))
(define/override (on-deactivated) (define/override (on-deactivated)
(format "bye, meow")))) "bye meow ~")))
(module+ main (module+ main
(require ansi) (require ansi)
@ -37,20 +82,12 @@
;; gang ;; gang
(date-display-format 'iso-8601) (date-display-format 'iso-8601)
(displayln "fetching users")
(define users (list-users)) (define users (list-users))
(displayln "fetching posts")
(define posts (get-posts users)) (define posts (get-posts users))
(displayln "calculting modtimes")
(define modtimes (make-hash)) (define modtimes (make-hash))
(void (dfs-modtime posts '() modtimes)) (void (dfs-modtime posts '() modtimes))
(define raw-entries (run-application "MeowBB" (new meowbb-forum-list% [posts posts] [modtimes modtimes])))
(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])))