robur/git-kv
4
0
Fork 0
Code Issues Pull requests 1 Projects Releases Packages Wiki Activity Actions

fix search invocation so that something is found

Browse source
This commit is contained in:
Hannes Mehnert 2022-09-26 12:03:12 +02:00
parent 79dd40ba70
commit 682de3e8b8
1 changed files with 4 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/git_kv.ml
View file

@ -144,10 +144,10 @@ let exists t key =
match t.head with
| None -> Lwt.return (Ok None)
| Some head ->
Search.mem t.store head (`Path (Mirage_kv.Key.segments key)) >>= function
Search.mem t.store head (`Commit (`Path (Mirage_kv.Key.segments key))) >>= function
| false -> Lwt.return (Ok None)
| true ->
Search.find t.store head (`Path (Mirage_kv.Key.segments key))
Search.find t.store head (`Commit (`Path (Mirage_kv.Key.segments key)))
>|= Option.get >>= Store.read_exn t.store >>= function
| Blob _ -> Lwt.return (Ok (Some `Value))
| Tree _ | Commit _ | Tag _ -> Lwt.return (Ok (Some `Dictionary))
@ -157,7 +157,7 @@ let get t key =
match t.head with
| None -> Lwt.return (Error (`Not_found key))
| Some head ->
Search.find t.store head (`Path (Mirage_kv.Key.segments key)) >>= function
Search.find t.store head (`Commit (`Path (Mirage_kv.Key.segments key))) >>= function
| None -> Lwt.return (Error (`Not_found key))
| Some blob ->
Store.read_exn t.store blob >|= function
@ -178,7 +178,7 @@ let list t key =
match t.head with
| None -> Lwt.return (Error (`Not_found key))
| Some head ->
Search.find t.store head (`Path (Mirage_kv.Key.segments key)) >>= function
Search.find t.store head (`Commit (`Path (Mirage_kv.Key.segments key))) >>= function
| None -> Lwt.return (Error (`Not_found key))
| Some tree ->
Store.read_exn t.store tree >>= function