From 9ea884409b5b17db9ec0b1a419c91f4182fbaf7d Mon Sep 17 00:00:00 2001 From: haskal Date: Sun, 4 Apr 2021 03:22:57 -0400 Subject: [PATCH] make launcher --- info.rkt | 11 +++-- main.rkt | 147 ++++++++++++++++++++++++++++++++++++++++++------------- tui.rkt | 114 ------------------------------------------ 3 files changed, 121 insertions(+), 151 deletions(-) delete mode 100644 tui.rkt diff --git a/info.rkt b/info.rkt index d9e7c1c..e59eb6b 100644 --- a/info.rkt +++ b/info.rkt @@ -1,9 +1,14 @@ #lang info (define collection "meowbb") -(define deps '("base" "raart" "lux")) -(define build-deps '("scribble-lib" "racket-doc" "rackunit-lib")) -(define scribblings '(("scribblings/meowbb.scrbl" ()))) (define pkg-desc "unix.lgbt forum browser") (define version "0.1") (define pkg-authors '(haskal)) + +(define deps '("base" "raart" "lux")) +(define build-deps '("scribble-lib" "racket-doc" "rackunit-lib")) + +(define scribblings '(("scribblings/meowbb.scrbl" ()))) + +(define racket-launcher-names '("meowbb")) +(define racket-launcher-libraries '("main")) diff --git a/main.rkt b/main.rkt index 7e16dd4..e2f9bee 100644 --- a/main.rkt +++ b/main.rkt @@ -1,50 +1,129 @@ #lang racket/base +(require racket/class racket/date racket/list racket/match + "fs.rkt" + "framework.rkt") + (module+ test (require rackunit)) -;; Notice -;; To install (from within the package directory): -;; $ raco pkg install -;; To install (once uploaded to pkgs.racket-lang.org): -;; $ raco pkg install <> -;; To uninstall: -;; $ raco pkg remove <> -;; To view documentation: -;; $ raco docs <> -;; -;; For your convenience, we have included LICENSE-MIT and LICENSE-APACHE files. -;; If you would prefer to use a different license, replace those files with the -;; desired license. -;; -;; Some users like to add a `private/` directory, place auxiliary files there, -;; and require them in `main.rkt`. -;; -;; See the current version of the racket style guide here: -;; http://docs.racket-lang.org/style/index.html -;; Code here +(define (timestamp->string ts) + (date->string (seconds->date ts #t) #t)) +(define meowbb-post-view% + (class activity% + (init-field posts) + (init-field modtimes) + (init-field path) + + (define post (first (hash-ref (hash-ref* posts path) *post-index*))) + + (define root + (new header/footer% + [header (new label% [label-text (format "meowbb : ~a" + (cons (post-forum post) (post-path post)))])] + [body (new scroll-pane% + [body (new text-pane% [content (post-content post)])])] + [footer (new label% [label-text "[JK] scroll | [Q] back"])])) + + (super-new [root root]) + + (define/override (on-event e) + (match e + ["q" 'quit] + [_ 'continue])))) + +(define meowbb-post-list% + (class activity% + (init-field posts) + (init-field modtimes) + (init-field forum) + + (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 (format "meowbb : ~a" forum)])] + [body (new scroll-pane% + [body (new table% + [headers '("title" "author" "updated")] + [cells entries])])] + [footer (new label% [label-text "[JK] navigate | [ENTER] select | [Q] back"])])) + + (super-new [root root]) + + (define/override (on-event e) + (match e + ["q" 'quit] + [(app-event _ 'selection row) + (define post (first (hash-ref (list-ref sorted row) *post-index*))) + (new meowbb-post-view% [posts posts] [modtimes modtimes] + [path (cons forum (post-path post))])] + [_ 'continue])))) + +(define meowbb-forum-list% + (class activity% + (init-field posts) + (init-field modtimes) + + (define forums (sort (hash-keys posts) stringstring (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"])])) + + (super-new [root root]) + + (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])] + [_ 'continue])) + + (define/override (on-deactivated) + "bye meow ~"))) + +(define (tui-main) + ;; 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)) + + (run-application "meowbb" (new meowbb-forum-list% [posts posts] [modtimes modtimes]))) (module+ test - ;; Any code in this `test` submodule runs when this file is run using DrRacket - ;; or with `raco test`. The code here does not run when this file is - ;; required by another module. - + ;; tests lol (check-equal? (+ 2 2) 4)) -(module+ main - ;; (Optional) main submodule. Put code here if you need it to be executed when - ;; this file is run using DrRacket or the `racket` executable. The code here - ;; does not run when this file is required by another module. Documentation: - ;; http://docs.racket-lang.org/guide/Module_Syntax.html#%28part._main-and-test%29 +(module+ main (require racket/cmdline) - (define who (box "world")) (command-line - #:program "my-program" - #:once-each - [("-n" "--name") name "Who to say hello to" (set-box! who name)] + #:program "meowbb" #:args () - (printf "hello ~a~n" (unbox who)))) + (tui-main))) diff --git a/tui.rkt b/tui.rkt deleted file mode 100644 index 16be0fb..0000000 --- a/tui.rkt +++ /dev/null @@ -1,114 +0,0 @@ -#lang racket/base - -(require racket/class racket/date racket/list racket/match - "fs.rkt" - "framework.rkt") - -(define (timestamp->string ts) - (date->string (seconds->date ts #t) #t)) - -(define meowbb-post-view% - (class activity% - (init-field posts) - (init-field modtimes) - (init-field path) - - (define post (first (hash-ref (hash-ref* posts path) *post-index*))) - - (define root - (new header/footer% - [header (new label% [label-text (format "meowbb : ~a" - (cons (post-forum post) (post-path post)))])] - [body (new scroll-pane% - [body (new text-pane% [content (post-content post)])])] - [footer (new label% [label-text "[JK] scroll | [Q] back"])])) - - (super-new [root root]) - - (define/override (on-event e) - (match e - ["q" 'quit] - [_ 'continue])))) - -(define meowbb-post-list% - (class activity% - (init-field posts) - (init-field modtimes) - (init-field forum) - - (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 (format "meowbb : ~a" forum)])] - [body (new scroll-pane% - [body (new table% - [headers '("title" "author" "updated")] - [cells entries])])] - [footer (new label% [label-text "[JK] navigate | [ENTER] select | [Q] back"])])) - - (super-new [root root]) - - (define/override (on-event e) - (match e - ["q" 'quit] - [(app-event _ 'selection row) - (define post (first (hash-ref (list-ref sorted row) *post-index*))) - (new meowbb-post-view% [posts posts] [modtimes modtimes] - [path (cons forum (post-path post))])] - [_ 'continue])))) - -(define meowbb-forum-list% - (class activity% - (init-field posts) - (init-field modtimes) - - (define forums (sort (hash-keys posts) stringstring (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"])])) - - (super-new [root root]) - - (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])] - [_ 'continue])) - - (define/override (on-deactivated) - "bye meow ~"))) - -(module+ main - (require ansi) - - ;; 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)) - - (run-application "MeowBB" (new meowbb-forum-list% [posts posts] [modtimes modtimes])))