fix store type errors

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

View File

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

View File

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

View File

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