Add homepage, architecture changes

* Create homepage
* Page data is automatically reloaded (except when compiling)
* Entrypoint is breezewiki.rkt for running and dist.rkt for compiling
* Include stack trace when sending error messages

src/page-home.rkt

@@ -0,0 +1,77 @@
+#lang racket/base
+
+(require html-writing
+         web-server/http
+         "xexpr-utils.rkt"
+         "config.rkt")
+
+(provide
+ page-home)
+
+(module+ test
+  (require rackunit))
+
+(define examples
+  '(("crosscode" "CrossCode_Wiki")
+    ("minecraft" "Bricks")
+    ("undertale" "Hot_Dog...%3F")
+    ("tardis" "Eleanor_Blake")
+    ("fireemblem" "God-Shattering_Star")
+    ("fallout" "Pip-Boy_3000")))
+
+(define content
+  `((h2 "BreezeWiki makes wiki pages on Fandom readable")
+    (p "It removes ads, videos, and suggested content, leaving you with a clean page that doesn't consume all your data.")
+    (p "If you're looking for an \"alternative\" to Fandom for writing pages, you should look elsewhere. BreezeWiki only lets you read existing pages.")
+    (p "BreezeWiki can also be called an \"alternative frontend for Fandom\".")
+    (h2 "Example pages")
+    (ul
+     ,@(map (λ (x)
+              `(li (a (@ (href ,(apply format "/~a/wiki/~a" x)))
+                      ,(apply format "~a: ~a" x))))
+            examples))
+    (h2 "How to use")
+    (p "While browsing any page on Fandom, you can replace \"fandom.com\" in the address bar with \"breezewiki.com\" to see the BreezeWiki version of that page.")
+    (p "After that, you can click the links to navigate around the pages.")
+    (p "To get back to Fandom, click the link that's at the bottom of the page.")))
+
+(define body
+  `(html
+    (head
+     (meta (@ (name ")viewport") (content "width=device-width, initial-scale=1")))
+     (title "About | BreezeWiki")
+     (link (@ (rel "stylesheet") (type "text/css") (href "/static/internal.css")))
+     (link (@ (rel "stylesheet") (type "text/css") (href "/static/main.css"))))
+    (body (@ (class "skin-fandomdesktop theme-fandomdesktop-light internal"))
+          (div (@ (class "main-container"))
+               (div (@ (class "fandom-community-header__background tileBoth header")))
+               (div (@ (class "page"))
+                    (main (@ (class "page__main"))
+                          (div (@ (class "custom-top"))
+                               (h1 (@ (class "page-title"))
+                                   "About BreezeWiki"))
+                          (div (@ (id "content") #;(class "page-content"))
+                               (div (@ (id "mw-content-text"))
+                                    ,@content))
+                          (footer (@ (class "custom-footer"))
+                                  (div (@ (class "internal-footer"))
+                                       (img (@ (class "my-logo") (src "/static/breezewiki.svg")))
+                                       ,(if (config-get 'instance-is-official)
+                                            `(p ,(format "This instance is run by the ~a developer, " (config-get 'application-name))
+                                                (a (@ (href "https://cadence.moe/contact"))
+                                                   "Cadence."))
+                                            `(p
+                                              ,(format "This unofficial instance is based off the ~a source code, but is not controlled by the code developer." (config-get 'application-name))))
+                                       (p "Text content on wikis run by Fandom is available under the Creative Commons Attribution-Share Alike License 3.0 (Unported), "
+                                          (a (@ (href "https://www.fandom.com/licensing")) "see license info.")
+                                          " Media files and official Fandom documents have different copying restrictions.")
+                                       (p ,(format "Fandom is a trademark of Fandom, Inc. ~a is not affiliated with Fandom." (config-get 'application-name)))))))))))
+(module+ test
+  (check-not-false (xexp->html body)))
+
+(define (page-home req)
+  (response/output
+   #:code 200
+   (λ (out)
+     (write-html body out))))
+

src/page-search.rkt

@@ -69,7 +69,7 @@
    (define data (easy:response-json dest-res))
 
    (define body (generate-results-page dest-url wikiname query data))
-   (when (config-get 'debug)
+   (when (config-true? 'debug)
      ; used for its side effects
      ; convert to string with error checking, error will be raised if xexp is invalid
      (xexp->html body))

src/reloadable.rkt

@@ -0,0 +1,150 @@
+#lang racket/base
+
+;;; Source: https://github.com/tonyg/racket-reloadable/blob/master/reloadable/main.rkt
+;;; Source commit: cae2a14 from 24 May 2015
+;;; Source license: LGPL 3 or later
+
+(provide (struct-out reloadable-entry-point)
+         reload-poll-interval
+         set-reload-poll-interval!
+         reload-failure-retry-delay
+         reload!
+         make-reloadable-entry-point
+         lookup-reloadable-entry-point
+         reloadable-entry-point->procedure
+         make-persistent-state)
+
+(require racket/set)
+(require racket/string)
+(require racket/match)
+(require racket/rerequire)
+
+(define reload-poll-interval 0.5) ;; seconds
+(define reload-failure-retry-delay (make-parameter 5)) ;; seconds
+
+(struct reloadable-entry-point (name
+                                module-path
+                                identifier-symbol
+                                on-absent
+                                [value #:mutable])
+        #:prefab)
+
+(define reloadable-entry-points (make-hash))
+(define persistent-state (make-hash))
+
+(define (set-reload-poll-interval! v)
+  (set! reload-poll-interval v))
+
+(define (reloader-main)
+  (let loop ()
+    (match (sync (handle-evt (thread-receive-evt)
+                             (lambda (_) (thread-receive)))
+                 (if reload-poll-interval
+                     (handle-evt (alarm-evt (+ (current-inexact-milliseconds)
+                                               (* reload-poll-interval 1000)))
+                                 (lambda (_) (list #f 'reload)))
+                     never-evt))
+      [(list ch 'reload)
+       (define result (do-reload!))
+       (when (not result) (sleep (reload-failure-retry-delay)))
+       (when ch (channel-put ch result))])
+    (loop)))
+
+(define reloader-thread (thread reloader-main))
+
+(define (reloader-rpc . request)
+  (define ch (make-channel))
+  (thread-send reloader-thread (cons ch request))
+  (channel-get ch))
+
+(define (reload!) (reloader-rpc 'reload))
+
+(define first-load? #t)
+(define (say-loading-once! port)
+  (when first-load?
+    (display "loading support files" port)
+    (set! first-load? #f)))
+
+(define (handle-loader-output)
+  (define i (thread-receive))
+  (define real-error-port (thread-receive))
+  (say-loading-once! real-error-port)
+  (let loop ()
+    (let ([line (read-line i)])
+      (cond
+        [(eof-object? line)
+         (void)]
+        [(string-contains? line "[load")
+         (display "." real-error-port)
+         (loop)]
+        [#t
+         (displayln line real-error-port)
+         (loop)]))))
+
+;; Only to be called from reloader-main
+(define (do-reload!)
+  (define module-paths (for/set ((e (in-hash-values reloadable-entry-points)))
+                         (reloadable-entry-point-module-path e)))
+  (with-handlers ((exn:fail?
+                   (lambda (e)
+                     (log-error "*** WHILE RELOADING CODE***\n~a"
+                                (parameterize ([current-error-port (open-output-string)])
+                                  ((error-display-handler) (exn-message e) e)
+                                  (get-output-string (current-error-port))))
+                     #f)))
+    (for ((module-path (in-set module-paths)))
+      (let ([real-error-port (current-error-port)])
+        (define-values (i o) (make-pipe))
+        (parameterize ([current-error-port o])
+          (define new-thread (thread handle-loader-output))
+          (thread-send new-thread i)
+          (thread-send new-thread real-error-port)
+          (dynamic-rerequire module-path #:verbosity 'all))))
+    (for ((e (in-hash-values reloadable-entry-points)))
+      (match-define (reloadable-entry-point _ module-path identifier-symbol on-absent _) e)
+      (define new-value (if on-absent
+                            (dynamic-require module-path identifier-symbol on-absent)
+                            (dynamic-require module-path identifier-symbol)))
+      (set-reloadable-entry-point-value! e new-value))
+    #t))
+
+(define (make-reloadable-entry-point name module-path [identifier-symbol name]
+                                     #:on-absent [on-absent #f])
+  (define key (list module-path name))
+  (hash-ref reloadable-entry-points
+            key
+            (lambda ()
+              (define e (reloadable-entry-point name module-path identifier-symbol on-absent #f))
+              (hash-set! reloadable-entry-points key e)
+              e)))
+
+(define (lookup-reloadable-entry-point name module-path)
+  (hash-ref reloadable-entry-points
+            (list module-path name)
+            (lambda ()
+              (error 'lookup-reloadable-entry-point
+                     "Reloadable-entry-point ~a not found in module ~a"
+                     name
+                     module-path))))
+
+(define (reloadable-entry-point->procedure e)
+  (make-keyword-procedure
+   (lambda (keywords keyword-values . positionals)
+     (keyword-apply (reloadable-entry-point-value e)
+                    keywords
+                    keyword-values
+                    positionals))))
+
+(define (make-persistent-state name initial-value-thunk)
+  (hash-ref persistent-state
+            name
+            (lambda ()
+              (define value (initial-value-thunk))
+              (define handler
+                (case-lambda
+                  [() value]
+                  [(new-value)
+                   (set! value new-value)
+                   value]))
+              (hash-set! persistent-state name handler)
+              handler)))

src/server-utils.rkt

@@ -0,0 +1,16 @@
+#lang racket/base
+
+(provide
+ ext->mime-type)
+
+(module+ test
+  (require rackunit))
+
+(define hash-ext-mime-type
+  (hash #".css" #"text/css"
+        #".svg" #"image/svg+xml"
+        #".png" #"image/png"))
+(define (ext->mime-type ext)
+  (hash-ref hash-ext-mime-type ext))
+(module+ test
+  (check-equal? (ext->mime-type #".png") #"image/png"))

src/xexpr-utils.rkt

@@ -195,6 +195,7 @@
                                 #:mime-type #"text/plain"
                                 (λ (out)
                                   (for ([port (list (current-output-port) out)])
-                                    (displayln "Exception raised in Racket code at response generation time:" port)
-                                    (displayln (exn-message e) port)))))])
+                                    (parameterize ([current-error-port out])
+                                      (displayln "Exception raised in Racket code at response generation time:" (current-error-port))
+                                      ((error-display-handler) (exn-message e) e))))))])
     body ...))