irmin - fail

open Lwt
open Irmin_unix

let path = IrminStorageConfig.store_path

module Git = IrminGit.FS(struct
    let root = Some path
      let bare = true
end)

module Store = Git.Make(IrminKey.SHA1)(IrminContents.String)(IrminTag.String)

(* convert key [a;b;c] to "/a/b/c" *)
let key_to_string key = 
 let open Core.Std in
 List.fold key 
 ~init:""
 ~f:(fun acc item -> 
   if acc = "" then
     "/" ^ item
   else
     acc ^ "/" ^ item
 ) 

(* list all keys under a given key k in the view v *)
let list_messages v k =
  let list_subtr v k =
    Store.View.list v [k] >>= fun l ->
    return (Core.Std.List.fold l ~init:"" ~f:(fun acc i ->
      acc ^ ":" ^ (Core.Std.List.last_exn i)
    ))
  in
  Store.View.list v [k] >>= fun l ->
  Lwt_list.fold_left_s (fun acc i ->
    list_subtr v i >>= fun s ->
    return (((key_to_string i) ^ ":" ^ s) :: acc)
  ) [] l

let main() =
  (* test the key k in the view v *)
  let test v k =
    Store.View.mem v k >>= fun res ->
    Printf.printf "testing: %s " (Core.Std.List.last_exn k);
    if res = true then (
      Printf.printf "removed\n%!"
    ) else (
      Printf.printf "still there\n%!"
    );
    (* try to read anyways *)
    Store.View.read v k >>= function
      | Some res -> Printf.printf "could read %s\n%!" res;return ()
      | None -> Printf.printf "could not read\n%!";return ()
  in
  (* read the key k in the view v *)
  let read v k =
    Store.View.read_exn v k >>= fun data -> 
    Printf.printf "%s: %s\n%!" (Core.Std.List.last_exn k) data; return ()
  in

  let view_key = ["imaplet";"user";"mailboxes";"Test"] in
  Store.create () >>= fun s ->
  (* clean up top level key *)
  Store.remove s view_key >>= fun () ->
  (* create a view *)
  Store.View.of_path s view_key >>= fun v ->
    (* update keys under the view *)
    Store.View.update v ["messages";"1"] "pseudo" >>= fun () ->
    Store.View.update v ["messages";"1";"header"] "Subject: Test" >>= fun () ->
    Store.View.update v ["messages";"1";"content"] "this is a test" >>= fun () ->
  (* commit the view *)
  Store.View.update_path s view_key v >>= fun () ->
  
  (* read back from the view *)
  Store.View.of_path s view_key >>= fun v ->
  read v ["messages";"1"] >>= fun () ->
  read v ["messages";"1";"header"] >>= fun () ->
  read v ["messages";"1";"content"] >>= fun () ->

  (* remove the key from the view *)
  Printf.printf "removing\n%!";
  Store.View.remove v ["messages";"1"] >>= fun () ->
  (* if remove this then behaves like messages;1 and list only returns 1
    Store.View.remove v ["messages";"1";"header"] >>= fun () ->
    Store.View.remove v ["messages";"1";"content"] >>= fun () ->
  *)
  (* commit the remove *)
  Store.View.update_path s view_key v >>= fun () ->
  (* now check the removed keys *)
  Printf.printf "--testing remove--\n%!";

  Store.View.of_path s view_key >>= fun v ->
  test v ["messages";"1"] >>= fun () ->
  test v ["messages";"1";"header"] >>= fun () ->
  test v ["messages";"1";"content"] >>= fun () ->
  (* list all under the key *)
  Printf.printf "listing message:1\n%!";
  list_messages v ["messages";"1"] >>= fun res ->
  Core.Std.List.iter res ~f:(fun i -> Printf.printf "list item: %s\n%!" i); 
  return()

let () =
  Lwt_unix.run (main())