module Store = Git_unix.Store
open Lwt_result.Syntax

type error =
  | Bad_request of string
  | Not_found of string
  | Store_error of Store.error
  | Internal of string

let pp_error formatter = function
  | Bad_request message -> Format.fprintf formatter "%s" message
  | Not_found message -> Format.fprintf formatter "%s" message
  | Store_error error -> Store.pp_error formatter error
  | Internal message -> Format.fprintf formatter "%s" message

let map_store promise =
  Lwt.map (Result.map_error (fun error -> Store_error error)) promise

let is_hex_digit = function
  | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
  | _ -> false

let is_valid_hash_hex hash =
  String.length hash = Store.Hash.length * 2 && String.for_all is_hex_digit hash

let hash_of_hex hash =
  if is_valid_hash_hex hash then Lwt_result.return (Store.Hash.of_hex hash)
  else Lwt_result.fail (Bad_request ("invalid object id " ^ hash))

let is_valid_repo_name repo =
  let invalid_char = function '\\' | '\x00' -> true | _ -> false in
  let valid_segment s =
    s <> "" && s <> "." && s <> ".." && not (String.starts_with ~prefix:"." s)
  in
  repo <> ""
  && (not (String.exists invalid_char repo))
  && String.split_on_char '/' repo |> List.for_all valid_segment

let validate_repo_name repo =
  if is_valid_repo_name repo then Lwt_result.return repo
  else Lwt_result.fail (Bad_request ("invalid repository name " ^ repo))

type repository_layout = { worktree : string; git_dir : string }

let filesystem_error path error =
  Internal (Printf.sprintf "%s: %s" path (Unix.error_message error))

(* These report filesystem failures rather than hiding them, so that a directory
   made unreadable by permissions is distinguishable from one that is simply not
   a repository. A missing path is not a failure: it answers the question with
   [false].

   The plain names belong to these error-preserving functions. It is
   [repository_layout_or_none] below, which discards the distinction, that
   carries the qualifier — the surprising behaviour is the one worth naming. *)

let is_directory path =
  try Ok ((Unix.stat path).st_kind = Unix.S_DIR) with
  | Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> Ok false
  | Unix.Unix_error (error, _, _) -> Error (filesystem_error path error)

let file_exists path =
  try
    ignore (Unix.stat path);
    Ok true
  with
  | Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> Ok false
  | Unix.Unix_error (error, _, _) -> Error (filesystem_error path error)

(* A directory is a Git directory when it holds both HEAD and objects/. *)
let is_git_directory path =
  let ( let* ) = Result.bind in
  let* directory = is_directory path in
  if not directory then Ok false
  else
    let* has_head = file_exists (Filename.concat path "HEAD") in
    let* has_objects = is_directory (Filename.concat path "objects") in
    Ok (has_head && has_objects)

(* [Ok None] means "readable, but not a repository"; [Error _] means "could not
   tell". Keeping them apart is the whole point of this layer. *)
let repository_layout path =
  let ( let* ) = Result.bind in
  let dotgit = Filename.concat path ".git" in
  let* worktree = is_directory path in
  if not worktree then Ok None
  else
    let* non_bare = is_git_directory dotgit in
    if non_bare then Ok (Some { worktree = path; git_dir = dotgit })
    else
      let* bare = is_git_directory path in
      if bare then Ok (Some { worktree = path; git_dir = path }) else Ok None

(** Collapse an unreadable path to [None], for the callers that cannot act on
    the difference anyway. Prefer {!repository_layout} where the distinction
    between "not a repository" and "could not tell" matters. *)
let repository_layout_or_none path =
  match repository_layout path with Ok layout -> layout | Error _ -> None

let is_repository path = Option.is_some (repository_layout_or_none path)

let repositories config =
  try
    let names = Sys.readdir config.Config.git_project_root |> Array.to_list in
    let ( let* ) = Result.bind in
    let rec collect repositories = function
      | [] -> Ok (List.sort String.compare repositories)
      | name :: rest when String.starts_with ~prefix:"." name ->
          collect repositories rest
      | name :: rest ->
          let path = Filename.concat config.Config.git_project_root name in
          let* layout = repository_layout path in
          collect
            (if Option.is_some layout then name :: repositories
             else repositories)
            rest
    in
    collect [] names
  with Sys_error message -> Error (Internal message)

type repo_info = { repo_name : string; description : string }
type fs_node = Repo of repo_info | Directory of string * fs_node list

let default_repo_description = "Unnamed repository"

let read_description_file description_path =
  try
    match
      In_channel.with_open_text description_path In_channel.input_all
      |> String.trim
    with
    | "" -> default_repo_description
    | description -> description
  with Sys_error _ -> default_repo_description

let description_of_layout { git_dir; _ } =
  Filename.concat git_dir "description" |> read_description_file

let scan_directory root_path =
  let ( let* ) = Result.bind in
  let rec scan dir_path =
    try
      let names =
        Sys.readdir dir_path |> Array.to_list |> List.sort String.compare
      in
      let rec collect acc = function
        | [] -> Ok (List.rev acc)
        | name :: rest when String.starts_with ~prefix:"." name ->
            collect acc rest
        | name :: rest -> (
            let path = Filename.concat dir_path name in
            let* is_dir = is_directory path in
            if not is_dir then collect acc rest
            else
              let* layout = repository_layout path in
              match layout with
              | Some layout ->
                  let description = description_of_layout layout in
                  collect (Repo { repo_name = name; description } :: acc) rest
              | None ->
                  let* children = scan path in
                  if children = [] then collect acc rest
                  else collect (Directory (name, children) :: acc) rest)
      in
      collect [] names
    with Sys_error message -> Error (Internal message)
  in
  scan root_path

let scan_project_root config = scan_directory config.Config.git_project_root

type repository = {
  name : string;
  store : Store.t;
  description : string;
  default_branch : string;
}

let open_repository config name =
  let* name = validate_repo_name name in
  let path = Filename.concat config.Config.git_project_root name in
  match repository_layout path with
  | Error error -> Lwt_result.fail error
  | Ok None -> Lwt_result.fail (Not_found ("not a Git repository " ^ name))
  | Ok (Some ({ worktree; git_dir } as layout)) ->
      (* ocaml-git's Store.v expects a tmp/ directory inside the git directory
         and fails if it cannot create one.  Since ogit only reads repositories,
         we ensure the directory exists beforehand so that Store.v succeeds even
         when the process lacks write access to the repository root. *)
      (let tmp = Filename.concat git_dir "tmp" in
       try Unix.mkdir tmp 0o755 with Unix.Unix_error _ -> ());
      let* store =
        map_store (Store.v ~dotgit:(Fpath.v git_dir) (Fpath.v worktree))
      in
      Lwt_result.return
        {
          name;
          store;
          description = description_of_layout layout;
          default_branch = config.Config.default_branch;
        }

let repository_name repository = repository.name
let repository_description repository = repository.description
let close_repository repository = Store.close_pack_files repository.store
let short_hash hash = String.sub hash 0 (min 8 (String.length hash))
let branch_ref name = Git.Reference.v ("refs/heads/" ^ name)

let fallback_branch_candidates_for default_branch =
  List.fold_left
    (fun candidates name ->
      if List.mem name candidates then candidates else candidates @ [ name ])
    []
    [ default_branch; "main"; "master" ]

let fallback_branch_candidates config =
  fallback_branch_candidates_for config.Config.default_branch

(** Parse a [packed-refs] file and return all entries as [(hex, refname)]
    pairs. This is the shared primitive used both by [resolve_head_hash] (which
    needs branch references for its fallback) and by [Reference.refs_by_prefix]
    (which enumerates branches and tags for the UI).

    [Store.Ref.list] only walks the filesystem for loose reference files; when a
    repository has been garbage-collected or was received as a pack, all refs
    live exclusively in [packed-refs] and are invisible to it. *)
let read_packed_refs_at git_dir =
  let path = Filename.concat git_dir "packed-refs" in
  try
    In_channel.with_open_text path @@ fun ic ->
    let rec collect acc =
      match In_channel.input_line ic with
      | None -> List.rev acc
      | Some line when String.length line = 0 -> collect acc
      | Some line when line.[0] = '#' || line.[0] = '^' -> collect acc
      | Some line -> (
          match String.index_opt line ' ' with
          | None -> collect acc
          | Some i ->
              let hex = String.sub line 0 i in
              let refname =
                String.sub line (i + 1) (String.length line - i - 1)
              in
              collect ((hex, refname) :: acc))
    in
    collect []
  with Sys_error _ -> []

let read_packed_refs store =
  read_packed_refs_at (Fpath.to_string (Store.dotgit store))

(** Cheaply resolve the commit hash that HEAD names, using plain file reads and
    no object store: HEAD itself, then one loose reference file, then
    [packed-refs]. [None] means "could not tell cheaply" — callers must fall
    back to opening the repository rather than conclude anything. *)
let head_hash_hint config name =
  let path = Filename.concat config.Config.git_project_root name in
  match repository_layout_or_none path with
  | None -> None
  | Some { git_dir; _ } -> (
      let first_line file =
        try In_channel.with_open_text file In_channel.input_line
        with Sys_error _ -> None
      in
      match first_line (Filename.concat git_dir "HEAD") with
      | None -> None
      | Some line -> (
          let line = String.trim line in
          if String.starts_with ~prefix:"ref: " line then
            let refname =
              String.trim (String.sub line 5 (String.length line - 5))
            in
            match first_line (Filename.concat git_dir refname) with
            | Some hex when is_valid_hash_hex (String.trim hex) ->
                Some (String.trim hex)
            | _ ->
                read_packed_refs_at git_dir
                |> List.find_opt (fun (_, packed_name) ->
                    packed_name = refname)
                |> Option.map fst
          else if is_valid_hash_hex line then Some line
          else None))

(** Branch entries from [packed-refs], returned as [(full_refname, reference)]
    pairs suitable for [try_references]. *)
let packed_refs_branches store =
  read_packed_refs store
  |> List.filter_map (fun (_hex, refname) ->
      if String.starts_with ~prefix:"refs/heads/" refname then
        Some (refname, Git.Reference.v refname)
      else None)

let resolve_head_hash repository =
  let resolve reference =
    map_store (Store.Ref.resolve repository.store reference)
  in
  let rec try_references = function
    | [] ->
        let open Lwt.Syntax in
        let* references = Store.Ref.list repository.store in
        let branches =
          references |> List.map fst
          |> List.filter_map (fun reference ->
              let name = Git.Reference.to_string reference in
              if String.starts_with ~prefix:"refs/heads/" name then
                Some (name, reference)
              else None)
        in
        (* When the store lists no loose branches, also consult packed-refs
           so that repositories with only packed references are handled. *)
        let branches =
          if branches = [] then packed_refs_branches repository.store
          else branches
        in
        let branches =
          List.sort
            (fun (left, _) (right, _) -> String.compare left right)
            branches
        in
        let rec try_branches = function
          | [] ->
              Lwt_result.fail
                (Not_found "no branch could be resolved for repository")
          | (_, reference) :: rest -> (
              Lwt.bind (resolve reference) @@ function
              | Ok hash -> Lwt_result.return hash
              | Error (Store_error (`Reference_not_found _)) ->
                  try_branches rest
              | Error error -> Lwt_result.fail error)
        in
        try_branches branches
    | reference :: rest -> (
        Lwt.bind (resolve reference) @@ function
        | Ok hash -> Lwt_result.return hash
        | Error (Store_error (`Reference_not_found _)) -> try_references rest
        | Error error -> Lwt_result.fail error)
  in
  Lwt.bind (resolve Git.Reference.head) @@ function
  | Ok hash -> Lwt_result.return hash
  | Error (Store_error (`Reference_not_found _)) ->
      fallback_branch_candidates_for repository.default_branch
      |> List.map branch_ref |> try_references
  | Error error -> Lwt_result.fail error

let read_value repository hash =
  Lwt.bind (Store.read repository.store hash) @@ function
  | Error (`Not_found _) ->
      Lwt_result.fail
        (Not_found ("no object matches id " ^ Store.Hash.to_hex hash))
  | Error error -> Lwt_result.fail (Store_error error)
  | Ok value -> Lwt_result.return value

let head_commit_date repository =
  let open Lwt.Syntax in
  let* result =
    Lwt_result.bind (resolve_head_hash repository) @@ fun hash ->
    Lwt.bind (Store.read repository.store hash) @@ function
    | Error _ -> Lwt_result.return None
    | Ok value -> (
        match value with
        | Git.Value.Commit commit ->
            let author = Store.Value.Commit.author commit in
            Lwt_result.return (Some author.Git.User.date)
        | _ -> Lwt_result.return None)
  in
  Lwt.return (Result.value result ~default:None)

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

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

  let to_t commit =
    Store.
      {
        hash = Value.Commit.digest commit |> Hash.to_hex;
        tree = Value.Commit.tree commit |> Hash.to_hex;
        parents = Value.Commit.parents commit |> List.map Hash.to_hex;
        author = Value.Commit.author commit;
        committer = Value.Commit.committer commit;
        message = Value.Commit.message commit;
      }

  let of_hash repository hash =
    Lwt_result.bind (read_value repository hash) @@ function
    | Git.Value.Commit commit -> Lwt_result.return (to_t commit)
    | _ ->
        Store.Hash.to_hex hash |> Printf.sprintf "no commit matches id %s"
        |> fun message -> Lwt_result.fail (Not_found message)

  let of_id repository id =
    let* hash = hash_of_hex id in
    of_hash repository hash

  (* A filtered walk with a rare predicate would otherwise traverse the whole
     history on every request. The cap bounds that work; callers learn through
     the second component of the result that older matches may exist beyond
     it. *)
  let default_max_examined = 5_000

  let recent_matching_from ?(max_examined = default_max_examined) repository
      hash count predicate =
    (* BFS traversal following all parents, ordered by author date descending.
       The queue is kept sorted via List.merge on insertion. This is O(n) per
       insert, but the queue length is bounded by the branch factor × count,
       which is small in practice (most commits have 1-2 parents). *)
    let module S = Set.Make (String) in
    let rec walk collected seen queue remaining examined =
      if remaining <= 0 then Lwt_result.return (List.rev collected, false)
      else if examined >= max_examined then
        (* Unexplored parents remain: the history was not exhausted. *)
        Lwt_result.return (List.rev collected, queue <> [])
      else
        match queue with
        | [] -> Lwt_result.return (List.rev collected, false)
        | (_, h) :: rest ->
            if S.mem h seen then walk collected seen rest remaining examined
            else
              let seen = S.add h seen in
              let* commit = of_id repository h in
              (* Enqueue all parents *)
              let new_queue =
                List.filter_map
                  (fun p ->
                    if S.mem p seen then None
                    else Some (commit.author.Git.User.date, p))
                  commit.parents
              in
              (* Merge into queue sorted by date descending *)
              let queue =
                List.merge
                  (fun ((a_ts, _), _) ((b_ts, _), _) -> Int64.compare b_ts a_ts)
                  rest new_queue
              in
              let collected, remaining =
                if predicate commit then (commit :: collected, remaining - 1)
                else (collected, remaining)
              in
              walk collected seen queue remaining (examined + 1)
    in
    walk [] S.empty [ ((Int64.max_int, None), hash) ] count 0

  let recent_from repository hash count =
    Lwt_result.map fst
      (recent_matching_from repository hash count (Fun.const true))

  let recent_matching ?max_examined repository count predicate =
    let* head_hash = resolve_head_hash repository in
    recent_matching_from ?max_examined repository
      (Store.Hash.to_hex head_hash)
      count predicate
end

module Reference = struct
  type t = { name : string; hash : string }

  let drop_prefix ~prefix name =
    if String.starts_with ~prefix name then
      Some
        (String.sub name (String.length prefix)
           (String.length name - String.length prefix))
    else None

  let branch_name name = drop_prefix ~prefix:"refs/heads/" name
  let tag_name name = drop_prefix ~prefix:"refs/tags/" name
  let to_t_with_name name (_, hash) = { name; hash = Store.Hash.to_hex hash }

  (** Enumerate references matching a given prefix, combining both loose
      references (from [Store.Ref.list]) and packed references read directly
      from the [packed-refs] file. Duplicates are removed by preferring the
      loose entry (which takes precedence in git's resolution order). *)
  let refs_by_prefix repository name_of_reference =
    let open Lwt.Syntax in
    let* references = Store.Ref.list repository.store in
    let from_loose =
      references
      |> List.filter_map (fun ((reference, _) as raw) ->
          Git.Reference.to_string reference
          |> name_of_reference
          |> Option.map (fun name -> to_t_with_name name raw))
    in
    let from_packed =
      read_packed_refs repository.store
      |> List.filter_map (fun (hex, refname) ->
          name_of_reference refname
          |> Option.map (fun name -> { name; hash = hex }))
    in
    (* Merge: loose refs win over packed refs for the same name *)
    let loose_names = List.map (fun r -> r.name) from_loose in
    let merged =
      from_loose
      @ List.filter (fun r -> not (List.mem r.name loose_names)) from_packed
    in
    merged
    |> List.sort (fun left right -> String.compare left.name right.name)
    |> Lwt_result.return

  let branches repository = refs_by_prefix repository branch_name

  let of_id repository id =
    let* branches = branches repository in
    match List.find_opt (fun branch -> branch.name = id) branches with
    | Some branch -> Lwt_result.return branch
    | None -> Lwt_result.fail (Not_found ("no reference matches id " ^ id))
end

let mode_of_perm : Git.Tree.perm -> int = function
  | `Commit -> 0o160000
  | `Dir -> 0o040000
  | `Everybody -> 0o100664
  | `Exec -> 0o100755
  | `Link -> 0o120000
  | `Normal -> 0o100644

module Entry = struct
  type perm = Dir | File | Exec | Link | Submodule
  type t = { hash : string; name : string; perm : perm }

  let perm_of_git : Git.Tree.perm -> perm = function
    | `Dir -> Dir
    | `Exec -> Exec
    | `Link -> Link
    | `Commit -> Submodule
    | `Normal | `Everybody -> File

  let to_t (entry : Store.Value.Tree.entry) =
    {
      hash = Store.Hash.to_hex entry.node;
      name = entry.name;
      perm = perm_of_git entry.perm;
    }

  let is_readme { name; _ } =
    String.(lowercase_ascii name |> starts_with ~prefix:"readme")
end

module Tree = struct
  type t = { entries : Entry.t list }
  type tree_node = { entry : Entry.t; children : tree_node list option }

  let to_t tree =
    { entries = Store.Value.Tree.to_list tree |> List.map Entry.to_t }

  let of_hash repository hash =
    Lwt_result.bind (read_value repository hash) @@ function
    | Git.Value.Tree tree -> Lwt_result.return (to_t tree)
    | _ ->
        Store.Hash.to_hex hash |> Printf.sprintf "no tree matches id %s"
        |> fun message -> Lwt_result.fail (Not_found message)

  let head_tree_hash repository =
    let* hash = resolve_head_hash repository in
    Lwt_result.bind (read_value repository hash) @@ function
    | Git.Value.Commit commit ->
        Lwt_result.return (Store.Value.Commit.tree commit)
    | _ -> Lwt_result.fail (Internal "HEAD does not point to a commit")

  let head repository =
    let* hash = head_tree_hash repository in
    of_hash repository hash

  let expand repository tree =
    let rec expand_entry (entry : Entry.t) =
      if entry.perm <> Entry.Dir then
        Lwt_result.return { entry; children = None }
      else collapse_single_subdirs entry.name entry.hash
    and collapse_single_subdirs prefix hash_hex =
      let* hash = hash_of_hex hash_hex in
      let* subtree =
        Lwt_result.bind (read_value repository hash) @@ function
        | Git.Value.Tree t -> Lwt_result.return (to_t t)
        | _ -> Lwt_result.return { entries = [] }
      in
      let entries = subtree.entries in
      match entries with
      | [ single ] when single.perm = Entry.Dir ->
          (* Single subdir — collapse into parent name and recurse *)
          let combined_name = prefix ^ "/" ^ single.name in
          collapse_single_subdirs combined_name single.hash
      | [ single ] when single.perm <> Entry.Dir ->
          (* Single file — present as a file with combined path name *)
          let combined_entry =
            {
              Entry.hash = single.hash;
              name = prefix ^ "/" ^ single.name;
              perm = single.perm;
            }
          in
          Lwt_result.return { entry = combined_entry; children = None }
      | _ ->
          let collapsed_entry =
            { Entry.hash = hash_hex; name = prefix; perm = Entry.Dir }
          in
          let* children = expand_entries entries in
          Lwt_result.return
            { entry = collapsed_entry; children = Some children }
    and expand_entries entries =
      let is_hidden (e : Entry.t) =
        String.length e.name > 0 && e.name.[0] = '.'
      in
      let sorted =
        List.sort
          (fun (a : Entry.t) (b : Entry.t) ->
            match (a.perm, b.perm) with
            | Entry.Dir, Entry.Dir ->
                let ha = is_hidden a and hb = is_hidden b in
                if ha = hb then String.compare a.name b.name
                else if ha then 1
                else -1
            | Entry.Dir, _ -> -1
            | _, Entry.Dir -> 1
            | _, _ ->
                let ha = is_hidden a and hb = is_hidden b in
                if ha = hb then String.compare a.name b.name
                else if ha then 1
                else -1)
          entries
      in
      let rec go acc = function
        | [] -> Lwt_result.return (List.rev acc)
        | e :: rest ->
            let* pe = expand_entry e in
            go (pe :: acc) rest
      in
      go [] sorted
    in
    expand_entries tree.entries

  let find_path repository target_hash =
    let* target = hash_of_hex target_hash in
    let* root = head_tree_hash repository in
    if Store.Hash.equal root target then Lwt_result.return []
    else
      let rec search trail tree_hash =
        Lwt_result.bind (read_value repository tree_hash) @@ function
        | Git.Value.Tree tree ->
            let rec try_entries = function
              | [] -> Lwt_result.return None
              | (entry : Store.Value.Tree.entry) :: rest ->
                  let step = (entry.name, Store.Hash.to_hex entry.node) in
                  if Store.Hash.equal entry.node target then
                    Lwt_result.return (Some (List.rev (step :: trail)))
                  else if entry.perm = `Dir then
                    let* found = search (step :: trail) entry.node in
                    match found with
                    | Some _ -> Lwt_result.return found
                    | None -> try_entries rest
                  else try_entries rest
            in
            try_entries (Store.Value.Tree.to_list tree)
        | _ -> Lwt_result.return None
      in
      let* result = search [] root in
      match result with
      | Some trail -> Lwt_result.return trail
      | None ->
          Lwt_result.fail
            (Not_found ("object is not reachable from HEAD: " ^ target_hash))
end

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

  let to_t blob = { content = Store.Value.Blob.to_string blob }
end

module Diff = struct
  module Path_map = Map.Make (String)
  include Line_diff

  type tree_file = { hash : string; perm : Git.Tree.perm }

  let rec flatten_tree repository prefix tree_hash files =
    let* hash = hash_of_hex tree_hash in
    Lwt_result.bind (read_value repository hash) @@ function
    | Git.Value.Tree tree ->
        let rec add_entries files = function
          | [] -> Lwt_result.return files
          | (entry : Store.Value.Tree.entry) :: entries ->
              let path =
                if prefix = "" then entry.name
                else Filename.concat prefix entry.name
              in
              let hash = Store.Hash.to_hex entry.node in
              let* files =
                match entry.perm with
                | `Dir -> flatten_tree repository path hash files
                | (`Commit | `Everybody | `Exec | `Link | `Normal) as perm ->
                    Lwt_result.return (Path_map.add path { hash; perm } files)
              in
              add_entries files entries
        in
        add_entries files (Store.Value.Tree.to_list tree)
    | _ -> Lwt_result.fail (Not_found ("no tree matches id " ^ tree_hash))

  let read_file repository = function
    | None -> Lwt_result.return ""
    | Some { hash; perm = `Commit } ->
        Lwt_result.return ("Subproject commit " ^ hash ^ "\n")
    | Some { hash; _ } -> (
        let* hash = hash_of_hex hash in
        Lwt_result.bind (read_value repository hash) @@ function
        | Git.Value.Blob blob ->
            Lwt_result.return (Store.Value.Blob.to_string blob)
        | _ -> Lwt_result.fail (Internal "file entry does not point to a blob"))

  let of_commit repository (commit : Commit.t) =
    let* new_files = flatten_tree repository "" commit.tree Path_map.empty in
    let* old_files =
      match commit.parents with
      | [] -> Lwt_result.return Path_map.empty
      | parent :: _ -> (
          let* parent_hash = hash_of_hex parent in
          Lwt_result.bind (read_value repository parent_hash) @@ function
          | Git.Value.Commit parent_commit ->
              Store.Value.Commit.tree parent_commit |> Store.Hash.to_hex
              |> fun tree -> flatten_tree repository "" tree Path_map.empty
          | _ -> Lwt_result.fail (Internal ("parent is not a commit " ^ parent))
          )
    in
    let changed_files =
      Path_map.merge
        (fun _ old_file new_file ->
          match (old_file, new_file) with
          | Some old_file, Some new_file
            when old_file.hash = new_file.hash && old_file.perm = new_file.perm
            ->
              None
          | None, None -> None
          | _ -> Some (old_file, new_file))
        old_files new_files
      |> Path_map.bindings
    in
    let rec build files = function
      | [] -> Lwt_result.return (List.rev files)
      | (path, (old_file, new_file)) :: rest ->
          let* old_content = read_file repository old_file in
          let* new_content = read_file repository new_file in
          let binary =
            String.contains old_content '\x00'
            || String.contains new_content '\x00'
          in
          let file =
            {
              path;
              old_hash = Option.map (fun file -> file.hash) old_file;
              new_hash = Option.map (fun file -> file.hash) new_file;
              old_mode =
                Option.map (fun file -> mode_of_perm file.perm) old_file;
              new_mode =
                Option.map (fun file -> mode_of_perm file.perm) new_file;
              binary;
              hunks =
                (if binary then []
                 else
                   Line_diff.of_contents old_content new_content
                   |> Line_diff.hunks);
            }
          in
          build (file :: files) rest
    in
    build [] changed_files
end

let blob_or_tree repository id =
  let* hash = hash_of_hex id in
  Lwt_result.bind (read_value repository hash) @@ function
  | Git.Value.Tree tree -> Lwt_result.return (`Tree (Tree.to_t tree))
  | Git.Value.Blob blob -> Lwt_result.return (`Blob (Blob.to_t blob))
  | _ -> Lwt_result.fail (Not_found ("no tree or blob matches id " ^ id))

(* Resolving by path walks at most one tree per segment, unlike
   [Tree.find_path], which searches the whole tree for a hash. *)
let object_at_path repository path =
  let segments =
    String.split_on_char '/' path |> List.filter (fun s -> s <> "")
  in
  let missing () = Lwt_result.fail (Not_found ("no such path: " ^ path)) in
  if segments = [] then
    Lwt_result.fail (Bad_request "empty path in repository")
  else
    let* root = Tree.head_tree_hash repository in
    let rec walk trail tree_hash = function
      | [] -> missing ()
      | segment :: rest -> (
          Lwt_result.bind (read_value repository tree_hash) @@ function
          | Git.Value.Tree tree -> (
              let entries = Store.Value.Tree.to_list tree in
              match
                List.find_opt
                  (fun (entry : Store.Value.Tree.entry) ->
                    entry.name = segment)
                  entries
              with
              | None -> missing ()
              | Some entry ->
                  let step = (entry.name, Store.Hash.to_hex entry.node) in
                  let trail = step :: trail in
                  if rest = [] then
                    Lwt_result.bind (read_value repository entry.node)
                    @@ function
                    | Git.Value.Blob blob ->
                        Lwt_result.return
                          (`Blob (Blob.to_t blob), List.rev trail)
                    | Git.Value.Tree tree ->
                        Lwt_result.return
                          (`Tree (Tree.to_t tree), List.rev trail)
                    | _ -> missing ()
                  else walk trail entry.node rest)
          | _ -> missing ())
    in
    walk [] root segments

module Readme = struct
  type t = { name : string; content : string }
end

module Repo = struct
  let readme repository =
    let* tree = Tree.head repository in
    match List.find_opt Entry.is_readme tree.entries with
    | None -> Lwt_result.return None
    | Some entry -> (
        let* hash = hash_of_hex entry.hash in
        Lwt_result.bind (read_value repository hash) @@ function
        | Git.Value.Blob blob ->
            Lwt_result.return
              (Some
                 Readme.
                   {
                     name = entry.name;
                     content = Store.Value.Blob.to_string blob;
                   })
        | _ -> Lwt_result.fail (Internal ("could not read file " ^ entry.name)))
end

let read_readme_in dir =
  let readme_candidates =
    [ "README"; "README.md"; "README.org"; "README.txt" ]
  in
  let rec try_candidates = function
    | [] -> None
    | name :: rest -> (
        let path = Filename.concat dir name in
        try
          let content = In_channel.with_open_text path In_channel.input_all in
          Some { Blob.content }
        with Sys_error _ -> try_candidates rest)
  in
  try_candidates readme_candidates

let read_root_readme config = read_readme_in config.Config.git_project_root

let scan_subdirectory config subdir =
  let full_path = Filename.concat config.Config.git_project_root subdir in
  if not (Sys.file_exists full_path && Sys.is_directory full_path) then
    Error (Not_found ("directory not found: " ^ subdir))
  else scan_directory full_path

let read_subdir_readme config subdir =
  read_readme_in (Filename.concat config.Config.git_project_root subdir)