(* -*- mode: tuareg; -*- *)

module Store = Git_unix.Store
open Lwt_result.Syntax

(* open Lwt_result.Infix *)
open Config

let full_path path = Filename.concat config.git_project_root path

let store repo =
  let path = full_path repo |> Fpath.v 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

let short_hash hash = String.sub hash 0 8

module Commit = struct
  type user = Git.User.t

  type t = {
    hash : string;
    parents : string list;
    author : user;
    message : string option;
  }

  let to_t c =
    let open Store.Value in
    {
      hash = Store.Value.Commit.digest c |> Store.Hash.to_hex;
      parents = Commit.parents c |> List.map Store.Hash.to_hex;
      author = Commit.author c;
      message = Commit.message c;
    }

  let of_id repo id =
    let* store = store repo in
    let hash = Store.Hash.of_hex id in
    Store.read store hash
    |> Lwt_result.map @@ function
       | Git.Value.Commit commit -> to_t commit
       | _ -> failwith (id ^ " does not point to a commit object")

  let head repo =
    let* store = store repo in
    let* hash = Store.Ref.resolve store Git.Reference.head in
    let id = hash |> Store.Hash.to_hex in
    of_id repo id

  let recent repo n =
    let* head_commit = head repo in
    let rec walk acc hash count =
      if count = 0 then Lwt_result.return (List.rev acc)
      else
        let* commit = of_id repo hash in
        match commit.parents with
        | parent_hash :: _ -> walk (commit :: acc) parent_hash (count - 1)
        | [] -> Lwt_result.return (List.rev (commit :: acc))
    in
    walk [] head_commit.hash n
end

(* module Branch = struct *)
(*   type t = { hash : string; name : string } *)

(*   let to_t (branch : Store.Reference.t) = *)
(*     { *)
(*       hash = Store.Reference.hash branch ; *)
(*       name = Store.Reference.contents branch; *)
(*     } *)

(*   let of_id repo id = *)
(*     let* store = store repo in *)
(*     let hash = Store.Hash.of_hex id in *)
(*     Store.Ref.resolve store hash *)
(*     |> Lwt_result.map @@ function *)
(*     | Git.Reference.Ref branch -> to_t branch *)
(*        | _ -> failwith "no head tree id" *)

(*   let all repo = *)
(*     let* store = store repo in *)
(*     let* refs = Store.Ref.list store in *)
(*     let branches = *)
(*       List.map *)
(*         (fun (reference, hash) -> *)
(*           let name = Git.Reference.to_string reference in *)
(*           let hash = Store.Hash.to_hex hash in *)
(*           { name; hash }) *)
(*         refs *)
(*     in *)
(*     Lwt_result.return branches *)
(* end *)

module Entry = struct
  type t = { hash : string; name : string; perm : int }

  let to_t (entry : Store.Value.Tree.entry) =
    let perm =
      match entry.perm with
      | `Commit -> 0o160000
      | `Dir -> 0o040000
      | `Everybody -> 0o100664
      | `Exec -> 0o100755
      | `Link -> 0o120000
      | `Normal -> 0o100644
    in
    let hash = Store.Hash.to_hex entry.node in
    { hash; name = entry.name; perm }
end

module Tree = struct
  type t = { hash : string; entries : Entry.t list }

  let to_t (tree : Store.Value.Tree.t) =
    let hash = Store.Value.Tree.hash tree |> Int.to_string in
    let entries = Store.Value.Tree.to_list tree |> List.map Entry.to_t in
    { hash; entries }

  let of_id repo id =
    let* store = store repo in
    let hash = Store.Hash.of_hex id in
    Store.read store hash
    |> Lwt_result.map @@ function
       | Git.Value.Tree tree -> to_t tree
       | _ -> failwith "no head tree id"

  let head repo : (t, Store.error) Lwt_result.t =
    let* store = store repo in
    let* hash =
      Store.Ref.resolve store Git.Reference.head
      |> Lwt_result.map Store.Hash.to_hex
    in
    of_id repo hash
end

module Blob = struct
  type t = { content : string }

  let to_t (blob : Store.Value.Blob.t) =
    { content = Store.Value.Blob.to_string blob }

  let of_id repo id =
    let* store = store repo in
    let hash = Store.Hash.of_hex id in
    Store.read store hash
    |> Lwt_result.map @@ function
       | Git.Value.Blob blob -> to_t blob
       | _ -> failwith (id ^ " does not point to a blob object")
end