swrup/gadgetobrr
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

tiny-httpd example

Browse Source
This commit is contained in:
Swrup 2024-04-16 06:58:24 +02:00
parent fc4b8f5b8f
commit 709718f802
6 changed files with 77 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
examples/content/dune Normal file
View File

@ -0,0 +1,8 @@
(rule
(target script.js)
(deps
(file ../script.bc.js))
(action
(with-stdout-to
%{target}
(cat ../script.bc.js))))

10
examples/content/index.html Normal file
View File

@ -0,0 +1,10 @@
<!DOCTYPE html>
<html>
<head>
<title>gadgetobrr</title>
<script src="/script.js" defer="defer"></script>
<link rel="stylesheet" href="/style.css">
</head>
<body>
</body>
</html>

0
examples/style.css → examples/content/style.css
View File

20
examples/dune
View File

@ -1,5 +1,21 @@
(executable
(name main)
(modules main)
(name runweb)
(modules runweb content)
(libraries tiny_httpd))
(executable
(name script)
(modules script)
(libraries js_of_ocaml brr gadgetobrr)
(modes js))
(rule
(target content.ml)
(deps
(file content/index.html)
(file content/style.css)
(file content/script.js))
(action
(with-stdout-to
%{null}
(run ocaml-crunch -m plain content -o %{target}))))

29
examples/runweb.ml Normal file
View File

@ -0,0 +1,29 @@
module S = Tiny_httpd
let asset_loader path =
match Content.read path with None -> assert false | Some asset -> asset
let () =
let server = S.create ~port:8000 () in
S.add_route_handler ~meth:`GET server S.Route.return (fun _req ->
S.Response.make_string
~headers:[ ("Content-Type", "text/html") ]
(Ok (asset_loader "index.html")) );
S.add_route_handler ~meth:`GET server
S.Route.(exact "script.js" @/ return)
(fun _req ->
S.Response.make_string
~headers:[ ("Content-Type", "application/javascript") ]
(Ok (asset_loader "script.js")) );
S.add_route_handler ~meth:`GET server
S.Route.(exact "style.css" @/ return)
(fun _req ->
S.Response.make_string
~headers:[ ("Content-Type", "text/css") ]
(Ok (asset_loader "style.css")) );
Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server);
ignore @@ Sys.command "xdg-open http://localhost:8000";
ignore (match S.run server with Ok () -> () | Error e -> raise e)

24
examples/main.ml → examples/script.ml
View File

@ -3,13 +3,13 @@
open Brr
open Gadgetobrr
let append_el_to_main el =
let main =
match El.find_first_by_selector (Jstr.v "main") with
| Some main -> main
| None -> failwith "append_el_to_main: main element not found"
let append_el_to_body el =
let body =
match El.find_first_by_selector (Jstr.v "body") with
| Some body -> body
| None -> failwith "append_el_to_body: body element not found"
in
El.append_children main [ el ];
El.append_children body [ el ];
()
let () =
@ -23,8 +23,8 @@ let () =
in
add_input_listener text (fun s -> Printf.printf "text value: %s\n" s);
mk_dragable text;
append_el_to_main (el text);
append_el_to_main datalist.datalist_el;
append_el_to_body (el text);
append_el_to_body datalist.datalist_el;
let datalist =
mk_datalist
@ -38,8 +38,8 @@ let () =
in
add_input_listener slider (fun x -> Printf.printf "slider value: %f\n" x);
mk_dragable slider;
append_el_to_main (el slider);
append_el_to_main datalist.datalist_el;
append_el_to_body (el slider);
append_el_to_body datalist.datalist_el;
let color =
mk_color ~value:"#00ff00" ~id:"my-color"
@ -47,12 +47,12 @@ let () =
in
add_input_listener color (fun s -> Printf.printf "color value: %s\n" s);
mk_dragable color;
append_el_to_main (el color);
append_el_to_body (el color);
let brridget_grid : El.t =
El.div ~d:G.document
~at:[ At.class' (Jstr.v "brridget-grid") ]
[ el text; el slider; el color ]
in
append_el_to_main brridget_grid;
append_el_to_body brridget_grid;
()