From 3c32f068fb8f87eb87439c8c635e84a88d936759 Mon Sep 17 00:00:00 2001 From: cqc Date: Sun, 24 Mar 2024 22:50:57 -0500 Subject: [PATCH] seems to kinda work, the userspace errors missing Html_types module --- .gitignore | 3 ++- cors_proxy.ml | 4 +++- dune | 43 +++++++++++++++++++++++++------------------ index.html | 9 --------- oplevel.ml | 18 +++++++++++++++--- store.ml | 8 +------- toplevel.mli | 1 - 7 files changed, 46 insertions(+), 40 deletions(-) diff --git a/.gitignore b/.gitignore index 5276a98..be61ab8 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ *~ -_build/ \ No newline at end of file +_build/ +gitkey.ml diff --git a/cors_proxy.ml b/cors_proxy.ml index ebc6a9a..66a3da2 100644 --- a/cors_proxy.ml +++ b/cors_proxy.ml @@ -37,7 +37,9 @@ let proxy_handler reqd : unit = | Request.{ meth; headers; target; _ } -> Lwt.async (fun () -> let filename = Fmt.str "./%s" target in - if Sys.file_exists filename && Sys.is_regular_file filename + if + Sys.file_exists + filename (* && Sys.is_regular_file filename *) then ( let file = Lwt_io.open_file ~flags:[ O_RDONLY ] ~mode:Lwt_io.input diff --git a/dune b/dune index 9705757..3b7aebb 100644 --- a/dune +++ b/dune @@ -4,8 +4,7 @@ (executables (names cors_proxy) (libraries httpaf httpaf-lwt-unix base stdio fmt http-lwt-client) - (modules cors_proxy) -) + (modules cors_proxy)) (library (name store) (libraries @@ -17,7 +16,7 @@ cohttp-lwt-jsoo mimic js_of_ocaml) - (modules store) + (modules store gitkey) (preprocess (pps js_of_ocaml-ppx))) @@ -29,6 +28,8 @@ lwt js_of_ocaml-lwt ;; not used directly graphics + tyxml + tyxml.functor js_of_ocaml.deriving react reactiveData str dynlink @@ -36,31 +37,38 @@ higlo js_of_ocaml-lwt.graphics js_of_ocaml-ppx + js_of_ocaml-compiler.runtime + js_of_ocaml-compiler.dynlink uucp - httpaf) + httpaf + tyxml-ppx + tyxml-syntax) (flags (:standard -rectypes -warn-error -A)) (link_flags - (:standard -linkall)) - (modes byte js) + (:standard -linkall -keep-docs -keep-locs )) + (modes js byte ) (js_of_ocaml (link_flags (:standard)) (build_runtime_flags (:standard - ;; +oplevel.js + +toplevel.js +dynlink.js --file %{dep:examples.ml} --file %{dep:test_dynlink.cmo} --file - %{dep:test_dynlink.js})) + %{dep:test_dynlink.js} +)) + (flags (:standard - --toplevel - (:include effects_flags.sexp)))) + --toplevel --linkall --target-env=browser + (:include effects_flags.sexp) + ))) (modules - oplevel toplevel ppx_support graphics_support colorize ocp_indent indent b64) + oplevel toplevel ppx_support graphics_support colorize ocp_indent indent b64 ) (preprocess (pps js_of_ocaml-ppx))) @@ -89,9 +97,11 @@ -o %{targets} stdlib + graphics str dynlink - js_of_ocaml.graphics + js_of_ocaml-compiler.runtime + js_of_ocaml-lwt.graphics js_of_ocaml-ppx.as-lib js_of_ocaml.deriving lwt @@ -139,15 +149,12 @@ %{dep:test_dynlink.cmo} --file %{dep:test_dynlink.js} - --export - %{dep:export.txt} - --toplevel - --disable - shortvar + --toplevel + --linkall %{dep:oplevel.bc} -o %{targets}))) (alias (name default) - (deps oplevel.js oplevel.bc.js index.html)) + (deps oplevel.bc.js index.html)) diff --git a/index.html b/index.html index e7f099d..be9e687 100644 --- a/index.html +++ b/index.html @@ -154,15 +154,6 @@ var prefix = ""; var version = ""; var main = "oplevel.bc.js"; - for(var f in fields){ - var data = fields[f].split(/=/); - if(data[0] == "version"){ - version = data[1].replace(/%20|%2B/g,"+"); - } - else if (data[0] == "separate"){ - main = "oplevel.bc.js"; - } - } function load_script(url){ var fileref=document.createElement('script'); fileref.setAttribute("type","text/javascript"); diff --git a/oplevel.ml b/oplevel.ml index 804f34d..e11a0a7 100644 --- a/oplevel.ml +++ b/oplevel.ml @@ -18,18 +18,29 @@ let resize ~container ~textbox () = container##.scrollTop := container##.scrollHeight; Lwt.return () +let appendchild ~container html = + Dom.appendChild container (Tyxml_js.To_dom.of_a html) + let _ = Dom_html.window##.onload := Dom_html.handler (fun _ -> Lwt.async (fun () -> let output = by_id "output" in let container = by_id "toplevel-container" in - + appendchild ~container + Tyxml_js.Html.( + a + ~a:[ a_class [ "window" ] ] + [ + div + ~a:[ a_class [ "status" ] ] + [ txt "starting..." ]; + ]); let textbox : 'a Js.t = by_id_coerce "userinput" Dom_html.CoerceTo.textarea in let rootrepo = Store.test_pull () in - rootrepo >>= fun (upstream, t) -> + rootrepo >>= fun (_upstream, t) -> Store.S.tree t >>= fun rootstore -> (try Store.S.Tree.get rootstore [ ".config"; "init.ml" ] @@ -88,7 +99,8 @@ let _ = Sync.pull_exn t upstream `Set >>= fun _ -> Firebug.console##log - (Js.string "Nav.test_pull(6)\n"); + (Js.string + "re-pulling rootstore for init.ml\n"); tree t >>= fun rs -> (try Store.S.Tree.get rs diff --git a/store.ml b/store.ml index a20b0b9..b038c93 100644 --- a/store.ml +++ b/store.ml @@ -366,13 +366,7 @@ let test_pull () : (Irmin.remote * Sync.db) Lwt.t = Firebug.console##log (Js.string "Nav.test_pull(4)\n"); let upstream = S.remote ~ctx - ~headers: - [ - ( "Authorization", - "Basic \ - Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=" - ); - ] + ~headers:[ ("Authorization", F.str "Basic %s" Gitkey.key) ] "http://localhost:8080/console/rootstore.git" in Firebug.console##log (Js.string "Nav.test_pull(5)\n"); diff --git a/toplevel.mli b/toplevel.mli index 1cda7ed..607ce69 100644 --- a/toplevel.mli +++ b/toplevel.mli @@ -1,5 +1,4 @@ open Js_of_ocaml -open Store val run : init:string ->