tiny-httpd example

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

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))))

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>

View file

@ -1,5 +1,21 @@
(executable (executable
(name main) (name runweb)
(modules main) (modules runweb content)
(libraries tiny_httpd))
(executable
(name script)
(modules script)
(libraries js_of_ocaml brr gadgetobrr) (libraries js_of_ocaml brr gadgetobrr)
(modes js)) (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)

View file

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