add forum and topic browser views
This commit is contained in:
parent
8079dda52f
commit
b21c80ccc9
|
@ -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
|
||||||
|
|
||||||
```
|
```
|
||||||
|
|
|
@ -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
77
tui.rkt
|
@ -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])))
|
|
||||||
|
|
Loading…
Reference in New Issue