From b84e82e1b7e7ac75e570a9855dd06edaa0ac5e09 Mon Sep 17 00:00:00 2001 From: Vivianne Langdon Date: Fri, 1 Dec 2023 02:08:33 -0500 Subject: [PATCH] initial commit --- .gitignore | 2 ++ README.md | 10 ++++++ hello.js | 19 +++++++++++ hello.scm | 86 ++++++++++++++++++++++++++++++++++++++++++++++++++ index.html | 8 +++++ web-server.scm | 38 ++++++++++++++++++++++ 6 files changed, 163 insertions(+) create mode 100644 .gitignore create mode 100644 README.md create mode 100644 hello.js create mode 100644 hello.scm create mode 100644 index.html create mode 100644 web-server.scm diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..09924a1 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.wasm +reflect.js diff --git a/README.md b/README.md new file mode 100644 index 0000000..c7be1ae --- /dev/null +++ b/README.md @@ -0,0 +1,10 @@ +# My hoot experiments! + +## Prerequisites +* Need hoot +* Need to put hoot's `reflect.js` in here +* Need to put hoot's `js-runtime/` folder in here + +## Running +* Run `guile hello.scm` to build the hello.wasm file +* Then run `guile web-server.scm` to run a web server and host the files on :8080 diff --git a/hello.js b/hello.js new file mode 100644 index 0000000..5e12404 --- /dev/null +++ b/hello.js @@ -0,0 +1,19 @@ +async function load() { + const [message] = await Scheme.load_main("hello.wasm", {}, { + js: { + alert: alert, + prompt: prompt, + }, + document: { + body() { return document.body; }, + createTextNode: Document.prototype.createTextNode.bind(document), + createElement: Document.prototype.createElement.bind(document), + }, + element: { + appendChild(parent, child) { return parent.appendChild(child); }, + setAttribute(elem, name, value) { elem.setAttribute(name, value); }, + } + }); + console.log(message); +} +window.addEventListener("load", load); diff --git a/hello.scm b/hello.scm new file mode 100644 index 0000000..696ec8e --- /dev/null +++ b/hello.scm @@ -0,0 +1,86 @@ +(use-modules (hoot compile) + (ice-9 binary-ports) + (wasm assemble)) +(define src + '(let () + (define (sxml->dom exp) + (match exp + ;; The simple case: a string representing a text node. + ((? string? str) + (make-text-node str)) + ;; An element tree. The first item is the HTML tag. + (((? symbol? tag) . body) + ;; Create a new element with the given tag. + (let ((elem (make-element (symbol->string tag)))) + (define (add-children children) + ;; Recursively call sxml->dom for each child node and + ;; append it to elem. + (for-each (lambda (child) + (append-child! elem (sxml->dom child))) + children)) + (match body + ;; '@' denotes an attribute list. Child nodes follow. + ((('@ . attrs) . children) + ;; Set attributes. + (for-each (lambda (attr) + (match attr + ;; Attributes are (symbol string) tuples. + (((? symbol? name) (? string? val)) + (set-attribute! elem + (symbol->string name) + val)))) + attrs) + (add-children children)) + ;; No attributes, just a list of child nodes. + (children (add-children children))) + elem)))) + + (define sxml + '(section + (h1 "Vivi rocks!") + (p "Vivi is the " + (b "best") + " and " + (i "rocks") + " :)") + (p "Go to " (a (@ (href "https://vvv.gay")) "vvv.gay") " now!"))) + + (define-foreign alert + "js" "alert" + (ref string) -> (ref null extern)) + + (define-foreign prompt + "js" "prompt" + (ref string) -> (ref string)) + + (define-foreign document-body + "document" "body" + -> (ref null extern)) + + (define-foreign make-text-node + "document" "createTextNode" + (ref string) -> (ref null extern)) + + (define-foreign append-child! + "element" "appendChild" + (ref null extern) (ref null extern) -> (ref null extern)) + + (define-foreign make-element + "document" "createElement" + (ref string) -> (ref null extern)) + + (define-foreign set-attribute! + "element" "setAttribute" + (ref null extern) (ref string) (ref string) -> none) + + (append-child! + (document-body) + (if (> (string->number (prompt "What's your age?")) 2) + (sxml->dom sxml) + (make-text-node "You probably can't read! What are you doing here??"))) + + "hey :)")) + +(call-with-output-file "hello.wasm" + (lambda (port) + (put-bytevector port (assemble-wasm (compile src))))) diff --git a/index.html b/index.html new file mode 100644 index 0000000..be296d4 --- /dev/null +++ b/index.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/web-server.scm b/web-server.scm new file mode 100644 index 0000000..670783b --- /dev/null +++ b/web-server.scm @@ -0,0 +1,38 @@ +(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) + (let ((f (string-append (getcwd) (uri-decode path)))) + (if (and (file-exists? f) (not (directory? f))) + (render-file f) + (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))