diff --git a/guile-docs/simple-web-server.scm b/guile-docs/simple-web-server.scm new file mode 100644 index 0000000..0fb378a --- /dev/null +++ b/guile-docs/simple-web-server.scm @@ -0,0 +1,47 @@ +;; Simplified guile web server outlined in +;; https://spritely.institute/news/building-interactive-web-pages-with-guile-hoot.html +;; Just using this for developing the homepage. + +(use-modules (ice-9 binary-ports) (ice-9 format) (ice-9 match) + (web server) (web request) (web response) (web uri)) + +(define (extension file) + (match (string-split file #\.) + (() #f) + ((_ ... ext) ext))) + +(define (mime-type file-name) + (or (assoc-ref '(("js" . application/javascript) + ("html" . text/html) + ("wasm" . application/wasm)) + (extension file-name)) + 'text/plain)) + +(define (render-file file-name) + (values `((content-type . (,(mime-type file-name)))) + (call-with-input-file file-name get-bytevector-all))) + +(define (not-found path) + (values (build-response #:code 404) (string-append "Not found: " path))) + +(define (directory? file-name) + (eq? (stat:type (stat file-name)) 'directory)) + +(define (serve-file path) + (define %prefix `(,(getcwd) "public")) + (define (prepend-prefix path) (string-join (append %prefix `(,path)) file-name-separator-string)) + + (let* ((f (prepend-prefix (uri-decode path)))) + (cond ((and (file-exists? f) (not (directory? f))) + (render-file f)) + ((equal? "/" path) + (render-file (prepend-prefix "index.html"))) + (else not-found path)))) + +(define (handle-request request body) + (let ((method (request-method request)) + (path (uri-path (request-uri request)))) + (format #t "~a ~a\n" method path) + (serve-file path))) + +(run-server handle-request 'http '(#:port 8080))