Compare commits
3 Commits
memes_grap
...
60c83c608a
| Author | SHA1 | Date | |
|---|---|---|---|
| 60c83c608a | |||
| 58ec73972b | |||
| b705c598ff |
@ -4,4 +4,4 @@ if [ ! -f /tmp/key.pem ]; then
|
|||||||
openssl req -newkey rsa:2048 -new -nodes -x509 -days 3650 -keyout /tmp/key.pem -out /tmp/cert.pem -batch
|
openssl req -newkey rsa:2048 -new -nodes -x509 -days 3650 -keyout /tmp/key.pem -out /tmp/cert.pem -batch
|
||||||
fi
|
fi
|
||||||
|
|
||||||
npx http-server --cors -S -P https://github.com --log-ip -c-1 -C /tmp/cert.pem -K /tmp/key.pem
|
npx http-server --cors -S -P https://gitea.departmentofinter.net --log-ip -c-1 -C /tmp/cert.pem -K /tmp/key.pem
|
||||||
|
|||||||
106
human.ml
106
human.ml
@ -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 "master" >>= 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/ryugyong/pocketbrain"
|
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
|
||||||
|
|
||||||
|
|||||||
@ -1,4 +1,4 @@
|
|||||||
<!DOCTYPE>
|
<!DOCTYPE html>
|
||||||
<html>
|
<html>
|
||||||
<head>
|
<head>
|
||||||
<style>
|
<style>
|
||||||
|
|||||||
26
notes.org
Normal file
26
notes.org
Normal file
@ -0,0 +1,26 @@
|
|||||||
|
* mvp todo
|
||||||
|
|
||||||
|
|
||||||
|
** toplevel repl in js_of_ocaml
|
||||||
|
** git pull from gitea.departmentofinter.net/console/boot
|
||||||
|
** git push to gitea.departmentofinter.net/console/boot
|
||||||
|
** execute a git file execution in top level
|
||||||
|
** display arbitrary git file from pulled repo
|
||||||
|
** edit arbitrary file with common emacs bindings
|
||||||
|
*** move left and right by character
|
||||||
|
*** move up and down by line
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
* other todo
|
||||||
|
*** yank (to clipboard) next char
|
||||||
|
*** move left and right by word and sentance
|
||||||
|
*** region select
|
||||||
|
|
||||||
|
|
||||||
|
* principles?
|
||||||
|
an "anywhere" programming environment
|
||||||
|
|
||||||
Reference in New Issue
Block a user