diff --git a/guile-docs.scm b/guile-docs.scm index 83d838b..6ceffc3 100644 --- a/guile-docs.scm +++ b/guile-docs.scm @@ -1,53 +1,7 @@ -;; Simplified guile web server outlined in -;; https://spritely.institute/files/docs/guile-hoot/0.2.0/Tutorial.html +(define-module (guile-docs) + #:use-module (web server) + #:use-module ((guile-docs server webserver) #:prefix webserver:) + #:export (launch-server)) -(use-modules (ice-9 binary-ports) (ice-9 format) (ice-9 match) - (web server) (web request) (web response) (web uri) - (haunt html)) - -(define (extension file) - (match (string-split file #\.) - (() #f) - ((_ ... ext) ext))) - -(define (mime-type file-name) - (or (assoc-ref '(("js" . application/javascript) - ("css" . text/css) - ("html" . text/html) - ("scm" . text/stml) - ("wasm" . application/wasm)) - (extension file-name)) - 'text/plain)) - -(define (render-file file-name) - (let ((type (mime-type file-name))) - (if (eq? type 'text/stml) - (values '((content-type . (text/html))) - (sxml->html-string (load file-name))) - (values `((content-type . (,type))) - (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.scm"))) - (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)) +(define (launch-server) + (run-server webserver:handle-request 'http '(#:port 8080))) diff --git a/guile-docs/server/webserver.scm b/guile-docs/server/webserver.scm new file mode 100644 index 0000000..a61bc57 --- /dev/null +++ b/guile-docs/server/webserver.scm @@ -0,0 +1,55 @@ +;; Simplified guile web server outlined in +;; https://spritely.institute/files/docs/guile-hoot/0.2.0/Tutorial.html + +(define-module (guile-docs server webserver) + #:use-module (guile-docs html templates) + #:use-module (ice-9 binary-ports) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (web server) + #:use-module (web request) + #:use-module (web response) + #:use-module (web uri) + #:use-module (haunt html) + #:export (handle-request)) + +(define (extension file) + (match (string-split file #\.) + (() #f) + ((_ ... ext) ext))) + +(define (mime-type file-name) + (or (assoc-ref '(("js" . application/javascript) + ("css" . text/css) + ("html" . text/html) + ("scm" . text/stml) + ("wasm" . application/wasm)) + (extension file-name)) + 'text/plain)) + +(define (render-html sxml) + (values '((content-type . (text/html))) + (sxml->html-string sxml))) + +(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-html index-page)) + (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)))