3 Commits

Author SHA1 Message Date
cqc
ee550301e9 made a weird deck a long time ago about this kinda stuff 2023-08-26 15:21:28 -05:00
cqc
60c83c608a looks like shit 2022-11-22 13:19:51 -06:00
cqc
58ec73972b lwd-ifying it 2022-11-22 02:21:45 -06:00
10 changed files with 107 additions and 23 deletions

1
doc/console.drawio Normal file
View File

@ -0,0 +1 @@
<mxfile host="Electron" modified="2023-03-13T23:21:20.375Z" agent="5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) draw.io/20.8.16 Chrome/106.0.5249.199 Electron/21.3.5 Safari/537.36" etag="Z2Mfk2ZBbl7WkBZ1-Pcz" version="20.8.16" type="device"><diagram name="Page-1" id="LQ51MIGZ5u8MJkVY-xBH">7Vttc9o4EP41zPQ6k4xlY2M+BpJcP+RuOpOZa/PpRtgyqJUtzogA/fUn2TK2LBFIwC9tmkyItdabtc8+u1qLgTONt3+mcLn4i4aIDGwr3A6c24FtD32bfwrBLhfYo3EumKc4zEWgFDziH0gKLSld4xCtlIqMUsLwUhUGNElQwBQZTFO6UatFlKijLuEcaYLHABJd+gWHbJFLfdcq5Z8Qni+KkYEl78SwqCwFqwUM6aYicu4GzjSllOVX8XaKiFi7Yl3ydvcH7u4nlqKEndIA3aL7+bd/bD8ef/nu3D7cpA/0SvbyDMlaPjBBjAtSFIjVgoEoJPwvu2nhSClaQhsLJATgmn8gskKiGaGwaPfxuuznQ3IF/pCLwXbFCjO05fOfLFhMuADwyxVL6Xc0pYSmXJLQhNecRJiQmggSPE94MeArgLh88oxShrnubuSNGIehGGayWWCGHpcwEGNuOFC5LKXrJERicfjTTAicIfKZrjDD1NjnQ63Cvu8FTfEPmjBYTD/ihXsYYyIgP6XrFPOObOtvxJU/kevNO0Xbg4oEe3hws0I0Rizd8So71TQ2JR7dAnWLChYdKYPSBOb7nkqU8AsJlFeAxvY01AxsjwgtrpYwUdTr/bcWAM8W5WojZ3cjwEHTWCzZpKzDr+byPynaGDurXnHLz0FRFTrAGjljpHctkMj1xQeWY/AFyIcphrYuMHrozTzX00fnuLnB2WAwFhBMZqvlftDfoiZEZiXvxTlejbAzahZ6vjXzdc1e7UcvYCRJ8MAEahy42uCYwOQQVVW48UVyETelCwWgQpAERWJY/kQELld4lg1rnclGW5VlJDl5OjkNgYGcwLAxdhqb2KkGjV76oLr6znckL9D3QYV6nqpQTZ9GdTamTV2ZUqVV/anreJYJVVQsmBwiPwo0PPA7XuCjWdSkIuyho2jCcTRV2G26fV9bdhTyWFkWacoWdE4TSO5KaQ3gZZ0HSpdSHd8QYzsJe7hmVFUW2mL2VTS/dmXpqXLndit7zgq7opDwx/1aLTxlPYzcoly2y0pFw9cgI4oiOzAiQ3r/Ahlikd6CC77SfAYBeqmipDoG0zl6sUcz0FJEIMPP6vRMuJFNP9Msetkzha/g060BL5++bFPD3n4Sb4ej1wkcD0DL/tWg5baErLMYydWcg6WBojHXELni1+gash/ZXUWe/zTpMoBfcxl6NOYYXIbdmPfu1GcU10+K/zD7jFfF1fUgwUV+ODQhwbdnToaEkjeu3SpzgCO00bidn+pBnGZcyNBWAVvvIZ9XYz5E3yqIDFe+Z5ulhxMZqwwMIo0BwHI7MCUx8rzYRbrK02r1LUuKYTI/uLM4ldRqW8RjSO8wHHYsFSquHg57Bm7zmuI2YNiadEB2DRNX4wQEiqz+MQYadxlpAD1RLjLe7znWsG01/B/p9thqrAEcTUWM/ivTcO8hXwAclSAB0DUyalUjejTe0+ivlW3dydhoMmPwU5Ctvq/L3yC2ZcUzEIaRZdKUfK/UpBW7NVr1NSMeum0a8bBLI75E2u88G345gupDqubkLGDuD36xNKAh5dNTJ/MqnL0ZzP3DJ/BOxafbCD7B+EBc1FKSAejHJa7eSURqj45tEVp9gwW6SUc2E1z23zGB0amGfwBGLYWbI80+QXv22cet/Ug9AjDq+i2C+7O4+IbePPc/i1fkPvu9sSxmWbH0jy1m8fp0mARYoGNfPO6TL76sgb5l99pD/336xvJc/20O3F0VsvU3OU1vLLtJfLxXD1Jsyo6fOLE7dSF6aNjTWOQi6Ybje5QeIunks0vnIslMW3b9PYzVbr7B0aOc3wegX3PQoHaIqrET0LxYfv0r1375HTrn7n8=</diagram></mxfile>

BIN
doc/console.drawio.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 17 KiB

BIN
doc/console.odp Normal file

Binary file not shown.

BIN
doc/console.pptx Normal file

Binary file not shown.

17
doc/deck_example.ml Normal file
View File

@ -0,0 +1,17 @@
let rec copy_blocks buffer r w =
match%lwt Lwt_io.read_into r buffer 0 (Bytes.length buffer) with
| 0 -> Lwt.return_unit
| bytes_read ->
let%lwt () = Lwt_io.write_from_exactly w buffer 0 bytes_read in
copy_blocks buffer r w
let run () =
((let%lwt server =
Lwt_io.establish_server (Lwt_unix.ADDR_INET (Unix.inet_addr_any, 8765))
(fun (r, w) ->
let buffer = Bytes.create (16 * 1024) in
copy_blocks buffer r w)
in
Lwt.return server) : Lwt_io.server Lwt.t) |> ignore
let () = Lwt_main.run run ();

1
doc/factorial.drawio Normal file
View File

@ -0,0 +1 @@
<mxfile host="Electron" modified="2023-03-14T02:21:12.395Z" agent="5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) draw.io/20.8.16 Chrome/106.0.5249.199 Electron/21.3.5 Safari/537.36" etag="kySTQQLOUsgllAWFhiTX" version="20.8.16" type="device"><diagram name="Page-1" id="LQ51MIGZ5u8MJkVY-xBH">7Vtbb6M4FP41kdKRWmEIhDy2Tbv70F2NNNLO9GnlgEk8dXCWOE06v35tMOFik9AkXGY6rVrhg318Od+5+BgPrPvl7o8IrhZ/UR+RgWn4u4E1HZimMwH8vyC8JQRrMkkI8wj7CQlkhC/4B5JEQ1I32EfrQkVGKWF4VSR6NAyRxwo0GEV0W6wWUFLsdQXnSCF88SBRqV+xzxYJ1bWNjP4nwvNF2jMw5JslTCtLwnoBfbrNkayHgXUfUcqSp+XuHhGxdum6JO0eK97uBxahkNVpgKbocf79H9NdTr6+WNOn2+iJXksur5Bs5IQJYpwQIU+sFvQYjTAUbEL+F9dwCO/ubhbxp7l4Sik+fhWzZG9y6Zz/NlS+z54KLdYrGGqbzKD3Mo/oJvSvPUpoNLBuxURCzMRYKljC5Yo/hLP1Ki4bOMiPWojFYAskCOCG/0NkjWIw/RsQCpms++mmNO1heA2u0gHzxU3GXJwHJ8eTT6lmYVImQztBX7AlH/sUiImziL6g+2Rq05CGvOZdgAkpkSDB85AXCQoEh1cUMcyheSvJjIqpbheYoS8r6InutlwJOS1eOyQEz2d/R+AMkc90zZePinYeRwyKcgyfShWW2PfF6O8WfBl+0JDBdOQBLzzCJSZCne/pJsKckWn8jbb7mQumaFcJUrCHPjcZiC4Ri954lbSBVJZtpmv2SNIWOT1LaVCq93zPKdMA/iCV4B0KYTqKRhyFq1iU660cnUBqSKNlNVBJ2uaouhgS/YXXFjDG1gSprHOw3eMy6Sbt2rhA774zc2xH7Z3j5hbHnZUV8TepAZJS1kv8oN2SKNCKGTquMXM1+I0BLk1mRacl+7fe4iWBsUHT2aqcXTxoXcRLGR8AoBpHPgsCV2s8i7s1LmuOZPCiM08joDFPoDn7NNHZpxIYLu6AFI+RuqC9pzjuhcryO9+VHDDglRJ1nIJEHUWeWnE2Jk1VmFKkefkV1/EsHcqJWNhyiNzAU/DA3ziei2ZBk4IwR1ZBEpaliMLUiMJqShSusuzI5zsBWaQRW9A5DSF5yKglgGd1nqiIzGJxfEeMvUnYww2jRWGhHWbfRPMbW5aec2+mO8k5LrylhZBP91u+8BxzGNtpOWsXl9KG70FGEASmp0WG9P8pMsQinYILvtJ8BB46VFGaOgajOTrIUQ+0CBHI8GtxeDrcyKafaRy/7C2FW8CnXQJeMnzZpoS9/SBOh6PTCRwroGX+atCyW0LWWRbJVpyDoYCiMdcQ2OJX6xriH8kuR09+mnQZwC25DDUaszQuw2zMe3fqM9Ln54L/0PuMdwXW5SDBRq4/0iHBNWdWjITMbtzYecsBjpiNxvW8rgexmnEhI7MI2DKHZFyN+RB1qyByYln+riqVsY7BIPZ5AKx2A10aI8mkXYRVkogrb1kiDMN55c6irlEr7RGPIb3DcNgyilCx1XDY0dg2pynbBjRbkw6MXcOGq3EDBNIzi2MWaNJlpAHUYwCRI//IsYZpFsP/saqPrcYawFJElB1dfIR8ASgZSABUiYxblYgajfc0+mtlW1cbG01mDH4KY6vu63InN22p8gz4fmDoxCWPl5pU5bJtdVVNNtvU5FGXmnyJ3N95inw4jOpDvqZ2KjBxCr9YLlCT9+mpp3kXzk4Gc//wCZy6+LQbwSdwKoKjljINQP1q4vpjhKWT8bFtQqunWKCblGQzAWb//RIY19X7ChS1FHKOFfUE7alnL7f3xc8Axl2fJNg/i4dv6PS5/5m8NP/Z781lOsqcpn9qMZPXpw9KgAE69sWTPvniyyroKZvXHvrv+vvKc/23Pm63i5Atn+Y0va/sJu/xUT1Iuic7/tWJ2akLUUPDnsYiF8k2HN+j9BBJtb9fOhdJerNlls9ijHbTDZYa5fz+CPo9Hxu4xe/aO/4K2lLPNqtuoQ2TC13JdTB2tS+kd7ji1pobauULFcP4dtgwdz0s5lWnaZkkL5UNwc3JLORdtOEwfxvtZG4nk+LLb+12OVTu2l01O4B67K8aMB8f7xJfKarN3+kzdPblhJ0YL2Y3aBP3kl1Dth7+Bw==</diagram></mxfile>

BIN
doc/factorial.drawio.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 32 KiB

3
dune
View File

@ -25,7 +25,6 @@
uri uri
zed zed
gg gg
wall lwd
)) ))

106
human.ml
View File

@ -68,13 +68,15 @@ module Logs_reporter = struct
in in
(Format.formatter_of_buffer b, flush) (Format.formatter_of_buffer b, flush)
let log_buf = Buffer.create 4096 let hook =
ref (fun level s ->
ignore (Logs.level_to_string (Some level) ^ ": " ^ s))
let console_report _src level ~over k msgf = let console_report _src level ~over k msgf =
let k _ = let k _ =
let s = flush () in let s = flush () in
console level s; console level s;
Buffer.add_string log_buf s; !hook level s;
over (); over ();
k () k ()
in in
@ -92,6 +94,7 @@ let _ =
Logs.set_level (Some Debug); Logs.set_level (Some Debug);
Logs.debug (fun m -> m "hello") Logs.debug (fun m -> m "hello")
module Log = Logs
module Cohttp_backend = Cohttp_lwt_jsoo module Cohttp_backend = Cohttp_lwt_jsoo
module Git_af = struct module Git_af = struct
@ -284,7 +287,10 @@ module Git_console_http = struct
match git_scheme with match git_scheme with
| `Git | `SSH | `Scheme _ -> Lwt.return_none | `Git | `SSH | `Scheme _ -> Lwt.return_none
| `HTTP | `HTTPS -> | `HTTP | `HTTPS ->
let headers = git_http_headers in let headers =
("content-type", "application/x-git-upload-pack-request")
:: git_http_headers
in
let handshake ~uri0 ~uri1 = function let handshake ~uri0 ~uri1 = function
| T.T flow -> ( | T.T flow -> (
Firebug.console##log Firebug.console##log
@ -450,12 +456,12 @@ module Nav = struct
Firebug.console##log (Js.string "Nav.test_pull()\n"); Firebug.console##log (Js.string "Nav.test_pull()\n");
S.Repo.v (Config.init "") >>= fun repo -> S.Repo.v (Config.init "") >>= fun repo ->
Firebug.console##log (Js.string "Nav.test_pull(2)\n"); Firebug.console##log (Js.string "Nav.test_pull(2)\n");
S.of_branch repo "main" >>= fun t -> S.of_branch repo "current" >>= fun t ->
Firebug.console##log (Js.string "Nav.test_pull(3)\n"); Firebug.console##log (Js.string "Nav.test_pull(3)\n");
Git_console_http.connect Mimic.empty >>= fun ctx -> Git_console_http.connect Mimic.empty >>= fun ctx ->
Firebug.console##log (Js.string "Nav.test_pull(4)\n"); Firebug.console##log (Js.string "Nav.test_pull(4)\n");
let upstream = let upstream =
S.remote ~ctx "https://localhost:8080/console/boot" S.remote ~ctx "https://localhost:8080/console/rootstore.git"
in in
Firebug.console##log (Js.string "Nav.test_pull(5)\n"); Firebug.console##log (Js.string "Nav.test_pull(5)\n");
Sync.fetch_exn t upstream >>= fun _ -> S.tree t Sync.fetch_exn t upstream >>= fun _ -> S.tree t
@ -1747,34 +1753,94 @@ module Panel = struct
scratch i will try to steal it. scratch i will try to steal it.
*) *)
(* we need to determine how "document types" should be implemented:
* as a module that implements a common interface which allows
production of a Ui.t which is then rendered.
* this will require exposing the Ui and all drawing related functions.
*
*)
module View = struct module View = struct
type path = Nav.path
type t = {
tree : Nav.tree;
view : path list Lwd.var;
cursor : Nav.path Lwd.var;
doc : node Lwd.t;
}
open Lwt.Infix open Lwt.Infix
let tree = ref (Nav.test_pull ()) let pack_x = Lwd_utils.lift_monoid (empty_node (), join_x)
let cursor = ref [] let pack_y = Lwd_utils.lift_monoid (empty_node (), join_y)
let pack_z = Lwd_utils.lift_monoid (empty_node (), join_z)
let contents tree = module DText = struct
Nav.S.Tree.list tree !cursor >>= fun l -> let lines = Lwd.map ~f:Text.lines
let of_string = Lwd.map ~f:Text.of_string
end
let of_path path =
Lwd.map2 ~f:join_x
(DText.of_string (Lwd.pure "/"))
(Lwd_utils.map_reduce
(fun step ->
Lwd_utils.pack
(empty_node (), join_x)
[
DText.of_string (Lwd.pure "/");
DText.of_string (Lwd.pure step);
])
pack_x path)
let of_tree ?(path = []) tree =
Nav.S.Tree.list tree path >>= fun l ->
Lwt.return Lwt.return
(String.concat "\n" (List.map (fun (step, _t') -> step) l)) {
tree;
view = Lwd.var [ path ];
cursor = Lwd.var path;
doc =
Lwd_utils.map_reduce
(fun (step, _t') -> DText.of_string (Lwd.pure step))
pack_y l;
}
type t = { tree : Nav.tree; mutable cursor : Nav.step } let list_logs hook =
let var = Lwd.var (empty_node ()) in
(hook :=
fun level s ->
Lwd.set var
(join_y
(Text.of_string
(Logs.level_to_string (Some level) ^ ": " ^ s))
(Lwd.peek var)));
Lwd.get var
let draw (vg, p) tree : p Lwt.t = let draw (vg, p) (t : node Lwd.t) : p Lwt.t =
contents tree >>= fun contents -> let root =
Lwt.return (Draw.node vg p (textedit (Text.lines contents))) Lwd.observe
~on_invalidate:(fun _ ->
Log.warn (fun m -> m "View.draw doc_root on_invalidate"))
t
in
Lwt.return (Draw.node vg p (Lwd.quick_sample root))
end end
open Lwt.Infix open Lwt.Infix
let render_lwt (vg : NVG.t) (p : p) (_ev : Event.t) : p Lwt.t = let render_lwt (vg : NVG.t) (p : p) (_ev : Event.t) : p Lwt.t =
let t = { vg; style = Style.dark } in let t = { vg; style = Style.dark } in
!View.tree >>= fun tree -> Nav.test_pull () >>= fun tree ->
View.draw (t, p) tree >>= fun p -> View.of_tree tree >>= fun doc ->
let module Buffer = Stdlib.Buffer in View.draw (t, p)
Lwt.return (Lwd_utils.reduce View.pack_y
(Draw.node t p [
(Text.lines (Buffer.contents Logs_reporter.log_buf))) doc.doc;
View.of_path (Lwd.peek doc.cursor);
View.list_logs Logs_reporter.hook;
])
end end
end end

View File

@ -1,4 +1,4 @@
<!DOCTYPE> <!DOCTYPE html>
<html> <html>
<head> <head>
<style> <style>