console/rootstore
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fix store type errors

Browse Source
This commit is contained in:
cqc
2024-03-29 20:19:31 -05:00
parent 78c1b61467
commit df15ad7efd
3 changed files with 14 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
.config/dune
View File

@ -18,13 +18,13 @@
uucp uucp
httpaf httpaf
digestif.ocaml digestif.ocaml
checkseum.ocaml checkseum.ocaml
irmin.mem irmin.mem
git git
irmin-git irmin-git
cohttp-lwt-jsoo cohttp-lwt-jsoo
mimic) mimic)
(modules init store) (modules init store)
(preprocess (preprocess
(pps js_of_ocaml-ppx)) (pps js_of_ocaml-ppx))
) )

8
.config/init.ml
View File

@ -107,15 +107,15 @@ let _ =
let textbox : 'a Js.t = let textbox : 'a Js.t =
by_id_coerce "userinput" Dom_html.CoerceTo.textarea by_id_coerce "userinput" Dom_html.CoerceTo.textarea
in in
let rootsync, rootstore = Store.test_pull () in Store.test_pull () >>= fun (remote, s) ->
rootstore >>= fun rs -> Store.S.tree s >>= fun root_tree ->
let workspace_store = let workspace_store =
Store.S.Tree.find_tree rs [ ".config"; "workspace" ] Store.S.Tree.find_tree root_tree [ ".config"; "workspace" ]
>>= function >>= function
| Some t -> Lwt.return t | Some t -> Lwt.return t
| None -> Lwt.return (Store.S.Tree.empty ()) | None -> Lwt.return (Store.S.Tree.empty ())
in in
setup_storeview ~storeview:rootstore ~container ~textbox; setup_storeview ~storeview:workspace_store ~container ~textbox;
Lwt.return Lwt.return
(Lwt.async (fun () -> (Lwt.async (fun () ->
setup_workspace ~container workspace_store))) setup_workspace ~container workspace_store)))

12
.config/store.ml
View File

@ -355,7 +355,7 @@ let test_populate () : t Lwt.t =
>>= add [ "hello"; "daddy" ] "ily" >>= add [ "hello"; "daddy" ] "ily"
>>= add [ "beep"; "beep" ] "motherfucker" >>= add [ "beep"; "beep" ] "motherfucker"
let test_pull () : t Lwt.t = let test_pull () : (Irmin.remote * Sync.db) Lwt.t =
(* test_populate ()*) (* test_populate ()*)
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 ->
@ -366,17 +366,11 @@ let test_pull () : t Lwt.t =
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 S.remote ~ctx
~headers: ~headers:[ ("Authorization", F.str "Basic %s" "") ]
[
( "Authorization",
"Basic \
Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM="
);
]
"http://localhost:8080/console/rootstore.git" "http://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.pull_exn t upstream `Set >>= fun _ -> Sync.pull_exn t upstream `Set >>= fun _ ->
Firebug.console##log (Js.string "Nav.test_pull(6)\n"); Firebug.console##log (Js.string "Nav.test_pull(6)\n");
S.tree t Lwt.return (upstream, t)
(* irmin/src/irmin/sync.ml: calls S.Remote.Backend.fetch *) (* irmin/src/irmin/sync.ml: calls S.Remote.Backend.fetch *)