TakeV/guile-docs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Activity

We're now using sxml or perhaps stml! fancy

Browse source
This commit is contained in:
Vivianne 2023-12-13 00:10:21 -05:00
parent 4c17a3630b
commit a6ea125204
3 changed files with 19 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
guile-docs.scm
View file

@ -2,7 +2,8 @@
;; https://spritely.institute/files/docs/guile-hoot/0.2.0/Tutorial.html ;; https://spritely.institute/files/docs/guile-hoot/0.2.0/Tutorial.html
(use-modules (ice-9 binary-ports) (ice-9 format) (ice-9 match) (use-modules (ice-9 binary-ports) (ice-9 format) (ice-9 match)
(web server) (web request) (web response) (web uri)) (web server) (web request) (web response) (web uri)
(haunt html))
(define (extension file) (define (extension file)
(match (string-split file #\.) (match (string-split file #\.)
@ -12,13 +13,21 @@
(define (mime-type file-name) (define (mime-type file-name)
(or (assoc-ref '(("js" . application/javascript) (or (assoc-ref '(("js" . application/javascript)
("html" . text/html) ("html" . text/html)
("scm" . text/stml)
("wasm" . application/wasm)) ("wasm" . application/wasm))
(extension file-name)) (extension file-name))
'text/plain)) 'text/plain))
(define (render-stml file-name)
(values '((content-type . (text/html)))
(sxml->html-string (load file-name))))
(define (render-file file-name) (define (render-file file-name)
(values `((content-type . (,(mime-type file-name)))) (let ((type (mime-type file-name)))
(call-with-input-file file-name get-bytevector-all))) (if (eq? type 'text/stml)
(render-stml file-name)
(values `((content-type . (,type)))
(call-with-input-file file-name get-bytevector-all)))))
(define (not-found path) (define (not-found path)
(values (build-response #:code 404) (string-append "Not found: " path))) (values (build-response #:code 404) (string-append "Not found: " path)))
@ -34,7 +43,7 @@
(cond ((and (file-exists? f) (not (directory? f))) (cond ((and (file-exists? f) (not (directory? f)))
(render-file f)) (render-file f))
((equal? "/" path) ((equal? "/" path)
(render-file (prepend-prefix "index.html"))) (render-file (prepend-prefix "index.scm")))
(else not-found path)))) (else not-found path))))
(define (handle-request request body) (define (handle-request request body)

10
public/index.html
View file

@ -1,10 +0,0 @@
<!DOCTYPE html>
<html>
<head>
<title>Welcome to Guile Docs</title>
</head>
<body>
<h1>Welcome to Guile Docs</h1>
<p>This is Guile Docs.</p>
</body>
</html>

6
public/index.scm Normal file
View file

@ -0,0 +1,6 @@
'(html
(head
(title "Welcome to Guile Docs"))
(body
(h1 "Welcome to Guile Docs")
(p "This is Guile Docs.")))