Commit d981e02a authored by Vlad Dumitru's avatar Vlad Dumitru
Browse files

basic stuff works again now

parent 9b881fdf
......@@ -16,7 +16,6 @@ type alias Metadata =
type alias Version =
{ id : String
, root : String
, info : Metadata
, head : Maybe String
}
......@@ -33,9 +32,8 @@ metadataDecoder =
decoder : Decoder Version
decoder =
D.map4 Version
D.map3 Version
(D.field "id" D.string)
(D.field "root" D.string)
(D.field "info" metadataDecoder)
(D.maybe (D.field "head" D.string))
......@@ -5,9 +5,15 @@ module C = Codec
module D = Decoders_yojson.Safe.Decode
let init repo_path =
let string_of_error = function
| `Duplicate_key k -> "duplicate key " ^ k
| `Decoding_error (name, reason) -> Fmt.str "failed to decode %s: %s" name (Decoders_yojson.Basic.Decode.string_of_error reason)
in
begin match Speechcake.load repo_path with
| Ok db -> db
| Error _ -> failwith "could not load"
| Error es ->
let reasons = List.map es ~f:string_of_error in
failwith (Base.String.concat ~sep:"\n" reasons)
end
let cors inner_handler request =
......@@ -84,7 +90,7 @@ let get_tier db request =
let tag = Dream.param "tag" request in
Speechcake.bucket db uuid
>>= fun bucket ->
Ok (Hashtbl.to_alist (Speechcake.Database.VS.tags bucket))
Ok (Hashtbl.to_alist (Speechcake.Database.VS.versions bucket))
>>= fun branches ->
Speechcake.get_tagged db uuid ~tag
>>| fun tagged -> uuid, branches, tagged in
......@@ -95,9 +101,9 @@ let get_tier db request =
[ "key", `List (List.map doc.Speechcake.Document.key ~f:(fun part -> `String part))
; "uuid", `String uuid
; "tags", `List (List.map (Set.to_list doc.tags) ~f:(fun tag -> `String tag))
(*; "versions", C.encode_version_listing (Core.Hashtbl.of_alist_exn (module Speechcake.Database.VS.Metadata.Hash) branches)*)
; "branches", `List (Base.List.map branches ~f:(fun (name, ptr) ->
`List [ `String name; `String (Speechcake.Database.VS.Metadata.string_of_hash ptr)]))
; "versions", C.encode_version_listing (Core.Hashtbl.of_alist_exn (module Speechcake.Database.VS.Metadata.Hash) branches)
(*; "branches", `List (Base.List.map branches ~f:(fun (name, ptr) ->
`List [ `String name; `String (Speechcake.Database.VS.Metadata.string_of_hash ptr)]))*)
]
|> Yojson.Safe.to_string in
Dream.json body
......@@ -160,6 +166,7 @@ let string_of_error = function
| `Cannot_diff -> "cannot diff"
| `Diffing_points_and_intervals -> "diffing points and intervals"
| `Persistent_store_error _ -> "persistent store error"
| `Duplicate_key k -> "duplicate key " ^ k
let json_of_error =
let open Decoders_yojson.Basic.Encode in
......@@ -469,3 +476,4 @@ let cmd =
let () =
let open Cmdliner in
Term.exit @@ Term.eval cmd
......@@ -152,7 +152,11 @@ let put ?author ?comment ?date ~parents ?(tag="latest") (t : t) k v =
let open Result.Monad_infix in
let key = v.Document.key in
let fingerprint = Fingerprint.of_tier fingerprint_size v.data in
let store = Core.Hashtbl.find_exn t.db k in
let store =
match Core.Hashtbl.find t.db k with
| Some store -> store
| None -> Database.VS.init ()
in
Database.VS.put' ?author ?comment ?date ~parents ~tag store v
>>| fun (store, hash) ->
Hashtbl.set t.db ~key:k ~data:store ;
......
......@@ -253,7 +253,7 @@ module Make (C : Contents.S) (S : Persistent_store.S) = struct
let decoder =
let open Decoders_yojson.Basic.Decode in
let* store = field "blocks" S.Decode.store in
let* store = field "store" S.Decode.store in
let* tags = field "tags" tag_map_decoder in
let+ versions = field "versions" (list version_decoder) in
{ store; tags; versions = Core.Hashtbl.of_alist_exn (module Hash) versions }
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment