diff options
| -rw-r--r-- | lib/git_presenters.ml | 111 |
1 files changed, 52 insertions, 59 deletions
diff --git a/lib/git_presenters.ml b/lib/git_presenters.ml index a3dbc96..feff7ac 100644 --- a/lib/git_presenters.ml +++ b/lib/git_presenters.ml @@ -1,9 +1,10 @@ (* -*- mode: tuareg; -*- *) module Store = Git_unix.Store +open Lwt_result.Syntax open Config -let full_path path = Filename.concat config.repositories_root_path path +let full_path path = Filename.concat config.git_project_root path let store repo = let path = Fpath.v @@ full_path repo in @@ -13,68 +14,60 @@ 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 -module User = struct - type t = Git.User.t -end +type user = Git.User.t -module Commit = struct - open Lwt_result.Syntax +(* let all_authors store = *) +(* let* store = store repo in *) - type t = { - hash : string; - short_hash : string; - parents : string list; - author : User.t; - message : string option; - } +type commit = { + hash : string; + short_hash : string; + parents : string list; + author : user; + message : string option; +} - let to_commit store h = - let* v = Store.read store h in - match v with - | Git.Value.Commit c -> - let hash = Store.Hash.to_hex h 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 to_commit store h = + let* v = Store.read store h in + match v with + | Git.Value.Commit c -> + let hash = Store.Hash.to_hex h 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 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 +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 - let of_id repo id = - let open Lwt_result.Syntax in - let* store = store repo in - let id = Store.Hash.of_hex id in - to_commit store id -end +let of_id repo id = + let* store = store repo in + let id = Store.Hash.of_hex id in + to_commit store id -module Branch = struct - type t = { name : string } +type branch = { name : string } - let all_branches repo = - let open Lwt_result.Syntax in - let* store = Git_unix.Store.v (Fpath.v repo) in - let open Lwt.Syntax in - let* refs = Store.Ref.list store in - let branches = - (* Filter these references for branches! *) - List.map (function _, x -> x |> Store.Hash.to_hex) refs - in - Lwt_result.return branches -end +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, _) -> { name = Git.Reference.to_string ref }) refs + in + Lwt_result.return branches |