(* -*- mode: tuareg; -*- *) module Store = Git_unix.Store open Lwt_result.Syntax open Config let full_path path = Filename.concat config.git_project_root path let store repo = let path = Fpath.v @@ full_path repo in Store.v ~dotgit:path path let repo_description repo = let description_path = Filename.concat (full_path repo) "description" in In_channel.with_open_text description_path In_channel.input_all type user = Git.User.t (* let all_authors store = *) (* let* store = store repo in *) type commit = { hash : string; short_hash : string; parents : string list; author : user; message : string option; } let to_commit store hash = let* v = Store.read store hash in match v with | Git.Value.Commit c -> let hash = Store.Hash.to_hex hash in Lwt_result.return { hash; short_hash = String.sub hash 0 8; parents = Store.Value.Commit.parents c |> List.map Store.Hash.to_hex; author = Store.Value.Commit.author c; message = Store.Value.Commit.message c; } | _ -> Lwt_result.fail (`Msg "value is not a commit") let commit_of_id repo id = let* store = store repo in let hash = Store.Hash.of_hex id in to_commit store hash let recent_commits repo n = let* store = store repo in let* head = Store.Ref.resolve store Git.Reference.head in let rec walk acc hash count = if count = 0 then Lwt_result.return (List.rev acc) else let* commit = to_commit store hash in match commit.parents with | parent :: _ -> walk (commit :: acc) (Store.Hash.of_hex parent) (count - 1) | [] -> Lwt_result.return (List.rev (commit :: acc)) in walk [] head n type branch = { hash : string; name : string } let all_branches repo = let* store = store repo in let open Lwt.Syntax in let* refs = Store.Ref.list store in let branches = List.map (fun (ref, hash) -> { name = Git.Reference.to_string ref; hash = Store.Hash.to_hex hash }) refs in Lwt_result.return branches type tree_entry = { hash : string; short_hash : string; name : string; perm : int; } type tree = { hash : string; short_hash : string; entries : tree_entry list } let to_entry _ = { hash = "foo"; short_hash = String.sub "foobar" 0 8; name = "foobarbino"; perm = 122; } let present_tree tree = Store.Value.Tree.to_list tree |> List.map to_entry let to_tree store hash = let* v = Store.read store hash in match v with | Git.Value.Tree tree -> let hash = Store.Hash.to_hex hash in Lwt_result.return { hash; short_hash = String.sub hash 0 8; entries = present_tree tree } | _ -> Dream.log "Value is not a tree"; Lwt_result.fail (`Msg "value is not a tree") let head_tree_id store = let* commit_hash = Store.Ref.resolve store Git.Reference.head in let* v = Store.read store commit_hash in match v with | Git.Value.Commit commit -> Store.Value.Commit.tree commit |> Lwt_result.return | _ -> Dream.log "no head tree id"; Lwt_result.fail (`Msg "") let head_tree repo = let* store = store repo in let* hash = head_tree_id store in to_tree store hash let tree_of_id repo id = let* store = store repo in let* hash = Lwt_result.return (Store.Hash.of_hex id) in to_tree store hash