src/ocaml_git.ml

type oid = string type signature = { name : string; email : string; epoch_seconds : int; timezone_offset_minutes : int; } type commit = { id : oid; summary : string; message : string; author : signature; committer : signature; parent_count : int; } type branch_type = Local | Remote type branch = { name : string; kind : branch_type; is_head : bool; } type tree_entry_kind = Blob | Tree | Commit | Tag | Other type tree_entry = { name : string; id : oid; kind : tree_entry_kind; } type tree_listing = { path : string; commit : commit; entries : tree_entry list; } type blob = { path : string; id : oid; bytes : string; } type status_flag = | Current | Index_new | Index_modified | Index_deleted | Index_renamed | Index_type_change | Worktree_new | Worktree_modified | Worktree_deleted | Worktree_type_change | Worktree_renamed | Worktree_unreadable | Ignored | Conflicted type status_entry = { path : string; flags : status_flag list; } exception Git_error of string let () : unit = Callback.register_exception "ocaml_git_error" (Git_error "") type repo_handle type index_handle type t = { handle : repo_handle; mutable closed : bool; } type index = { repo : t; handle : index_handle; mutable index_closed : bool; } (* Raw tuple shapes are the ABI between the C stubs and this OCaml layer. The conversion helpers below are the only place that should know those layouts. *) type signature_raw = string * string * int * int type commit_raw = string * string * string * signature_raw * signature_raw * int type branch_raw = string * int * bool type tree_entry_raw = string * string * int type status_raw = string * int list external libgit2_init : unit -> unit = "kg_libgit2_init" external libgit2_shutdown : unit -> unit = "kg_libgit2_shutdown" external raw_open : string -> repo_handle = "kg_open" external raw_init : string -> bool -> repo_handle = "kg_init" external raw_discover : string -> string = "kg_discover" external raw_close : repo_handle -> unit = "kg_close" external raw_git_dir : repo_handle -> string = "kg_git_dir" external raw_workdir : repo_handle -> string option = "kg_workdir" external raw_is_bare : repo_handle -> bool = "kg_is_bare" external raw_is_empty : repo_handle -> bool = "kg_is_empty" external raw_head_name : repo_handle -> string = "kg_head_name" external raw_head_commit : repo_handle -> commit_raw = "kg_head_commit" external raw_branch_commit : repo_handle -> string -> commit_raw = "kg_branch_commit" external raw_branches : repo_handle -> branch_raw list = "kg_branches" external raw_tree_entry : repo_handle -> string -> string -> tree_entry_raw = "kg_tree_entry" external raw_tree : repo_handle -> string -> string -> tree_entry_raw list = "kg_tree" external raw_blob : repo_handle -> string -> string = "kg_blob" external raw_commits : repo_handle -> string -> int -> commit_raw list = "kg_commits" external raw_commit_lookup : repo_handle -> string -> commit_raw = "kg_commit_lookup" external raw_commit_diff : repo_handle -> string -> string = "kg_commit_diff" external raw_status : repo_handle -> status_raw list = "kg_status" external raw_index : repo_handle -> index_handle = "kg_index" external raw_index_size : index_handle -> int = "kg_index_size" external raw_index_contains : index_handle -> string -> bool = "kg_index_contains" external raw_index_add : index_handle -> string -> unit = "kg_index_add" external raw_index_remove : index_handle -> string -> unit = "kg_index_remove" external raw_index_write : index_handle -> unit = "kg_index_write" external raw_index_close : index_handle -> unit = "kg_index_close" let () : unit = libgit2_init () let require_open (repo : t) : unit = if repo.closed then raise (Git_error "Repository is closed") let require_index_open (index : index) : unit = if index.index_closed then raise (Git_error "Index is closed") let signature_of_raw ((name, email, epoch_seconds, timezone_offset_minutes) : signature_raw) : signature = { name; email; epoch_seconds; timezone_offset_minutes } let commit_of_raw ((id, summary, message, author, committer, parent_count) : commit_raw) : commit = { id; summary; message; author = signature_of_raw author; committer = signature_of_raw committer; parent_count } let branch_kind (raw_kind : int) : branch_type = match raw_kind with | 0 -> Local | _ -> Remote let branch_of_raw ((name, kind, is_head) : branch_raw) : branch = { name; kind = branch_kind kind; is_head } let tree_entry_kind (raw_kind : int) : tree_entry_kind = match raw_kind with | 0 -> Blob | 1 -> Tree | 2 -> Commit | 3 -> Tag | _ -> Other let tree_entry_of_raw ((name, id, kind) : tree_entry_raw) : tree_entry = { name; id; kind = tree_entry_kind kind } let status_flag (raw_flag : int) : status_flag = match raw_flag with | 0 -> Current | 1 -> Index_new | 2 -> Index_modified | 3 -> Index_deleted | 4 -> Index_renamed | 5 -> Index_type_change | 6 -> Worktree_new | 7 -> Worktree_modified | 8 -> Worktree_deleted | 9 -> Worktree_type_change | 10 -> Worktree_renamed | 11 -> Worktree_unreadable | 12 -> Ignored | _ -> Conflicted let status_of_raw ((path, flags) : status_raw) : status_entry = { path; flags = List.map status_flag flags } let open_repo (path : string) : t = { handle = raw_open path; closed = false } let init ?(bare : bool = false) (path : string) : t = { handle = raw_init path bare; closed = false } let discover : string -> string = raw_discover let close (repo : t) : unit = if not repo.closed then raw_close repo.handle; repo.closed <- true let with_repo (path : string) (f : t -> 'a) : 'a = let repo = open_repo path in Fun.protect ~finally:(fun () -> close repo) (fun () -> f repo) let git_dir (repo : t) : string = require_open repo; raw_git_dir repo.handle let workdir (repo : t) : string option = require_open repo; raw_workdir repo.handle let is_bare (repo : t) : bool = require_open repo; raw_is_bare repo.handle let is_empty (repo : t) : bool = require_open repo; raw_is_empty repo.handle let head_name (repo : t) : string = require_open repo; raw_head_name repo.handle let head_commit (repo : t) : commit = require_open repo; raw_head_commit repo.handle |> commit_of_raw let branch_commit (repo : t) (branch : string) : commit = require_open repo; raw_branch_commit repo.handle branch |> commit_of_raw let branches (repo : t) : branch list = require_open repo; raw_branches repo.handle |> List.rev_map branch_of_raw let status (repo : t) : status_entry list = require_open repo; raw_status repo.handle |> List.map status_of_raw let tree_entry ?commit (repo : t) (path : string) : tree_entry = require_open repo; let commit = match commit with Some commit -> commit | None -> head_commit repo in raw_tree_entry repo.handle commit.id path |> tree_entry_of_raw (* Match the old display behavior: directories first, then lexical name order. *) let compare_entry (a : tree_entry) (b : tree_entry) : int = match (a.kind = Tree, b.kind = Tree) with | true, false -> -1 | false, true -> 1 | _ -> String.compare a.name b.name let tree ?commit ?(path : string = "") (repo : t) () : tree_listing = require_open repo; let commit = match commit with Some commit -> commit | None -> head_commit repo in let entries = raw_tree repo.handle commit.id path |> List.map tree_entry_of_raw |> List.sort compare_entry in { path; commit; entries } let blob ?commit (repo : t) (path : string) : blob = let entry = tree_entry ?commit repo path in if entry.kind <> Blob then raise (Git_error (path ^ " is not a blob")); { path; id = entry.id; bytes = raw_blob repo.handle entry.id } let commits ?(limit : int = 50) (repo : t) (branch : string) : commit list = require_open repo; raw_commits repo.handle branch limit |> List.map commit_of_raw let commit_lookup (repo : t) (id : oid) : commit = require_open repo; raw_commit_lookup repo.handle id |> commit_of_raw let commit_diff (repo : t) (id : oid) : string = require_open repo; raw_commit_diff repo.handle id let index (repo : t) : index = require_open repo; { repo; handle = raw_index repo.handle; index_closed = false } let index_size (index : index) : int = require_index_open index; raw_index_size index.handle let index_contains (index : index) (path : string) : bool = require_index_open index; raw_index_contains index.handle path let index_add (index : index) (path : string) : index = require_index_open index; raw_index_add index.handle path; index let index_remove (index : index) (path : string) : index = require_index_open index; raw_index_remove index.handle path; index let index_write (index : index) : index = require_index_open index; raw_index_write index.handle; index let close_index (index : index) : unit = if not index.index_closed then raw_index_close index.handle; index.index_closed <- true let blob_is_binary (blob : blob) : bool = String.contains blob.bytes '\000' let blob_text (blob : blob) : string = blob.bytes let shutdown () : unit = libgit2_shutdown ()