Repositories / ocaml-git.git
ocaml-git.git
Clone (read-only): git clone http://git.guha-anderson.com/git/ocaml-git.git
@@ -67,7 +67,7 @@ type status_entry = { exception Git_error of string -let () = Callback.register_exception "ocaml_git_error" (Git_error "") +let () : unit = Callback.register_exception "ocaml_git_error" (Git_error "") type repo_handle type index_handle @@ -83,6 +83,8 @@ type index = { 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 @@ -116,36 +118,39 @@ 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 () = libgit2_init () +let () : unit = libgit2_init () -let require_open repo = +let require_open (repo : t) : unit = if repo.closed then raise (Git_error "Repository is closed") -let require_index_open index = +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) = +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) = +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 = function +let branch_kind (raw_kind : int) : branch_type = + match raw_kind with | 0 -> Local | _ -> Remote -let branch_of_raw (name, kind, is_head) = { name; kind = branch_kind kind; is_head } +let branch_of_raw ((name, kind, is_head) : branch_raw) : branch = { name; kind = branch_kind kind; is_head } -let tree_entry_kind = function +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) = { name; id; kind = tree_entry_kind kind } +let tree_entry_of_raw ((name, id, kind) : tree_entry_raw) : tree_entry = { name; id; kind = tree_entry_kind kind } -let status_flag = function +let status_flag (raw_flag : int) : status_flag = + match raw_flag with | 0 -> Current | 1 -> Index_new | 2 -> Index_modified @@ -161,113 +166,114 @@ let status_flag = function | 12 -> Ignored | _ -> Conflicted -let status_of_raw (path, flags) = { path; flags = List.map status_flag flags } +let status_of_raw ((path, flags) : status_raw) : status_entry = { path; flags = List.map status_flag flags } -let open_repo path = { handle = raw_open path; closed = false } -let init ?(bare = false) path = { handle = raw_init path bare; closed = false } -let discover = raw_discover +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 = +let close (repo : t) : unit = if not repo.closed then raw_close repo.handle; repo.closed <- true -let with_repo path f = +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 = +let git_dir (repo : t) : string = require_open repo; raw_git_dir repo.handle -let workdir repo = +let workdir (repo : t) : string option = require_open repo; raw_workdir repo.handle -let is_bare repo = +let is_bare (repo : t) : bool = require_open repo; raw_is_bare repo.handle -let is_empty repo = +let is_empty (repo : t) : bool = require_open repo; raw_is_empty repo.handle -let head_name repo = +let head_name (repo : t) : string = require_open repo; raw_head_name repo.handle -let head_commit repo = +let head_commit (repo : t) : commit = require_open repo; raw_head_commit repo.handle |> commit_of_raw -let branch_commit repo branch = +let branch_commit (repo : t) (branch : string) : commit = require_open repo; raw_branch_commit repo.handle branch |> commit_of_raw -let branches repo = +let branches (repo : t) : branch list = require_open repo; raw_branches repo.handle |> List.rev_map branch_of_raw -let status repo = +let status (repo : t) : status_entry list = require_open repo; raw_status repo.handle |> List.map status_of_raw -let tree_entry ?commit repo path = +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 -let compare_entry a b = +(* 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 = "") repo () = +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 path = +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 = 50) repo branch = +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 index repo = +let index (repo : t) : index = require_open repo; { repo; handle = raw_index repo.handle; index_closed = false } -let index_size index = +let index_size (index : index) : int = require_index_open index; raw_index_size index.handle -let index_contains index path = +let index_contains (index : index) (path : string) : bool = require_index_open index; raw_index_contains index.handle path -let index_add index path = +let index_add (index : index) (path : string) : index = require_index_open index; raw_index_add index.handle path; index -let index_remove index path = +let index_remove (index : index) (path : string) : index = require_index_open index; raw_index_remove index.handle path; index -let index_write index = +let index_write (index : index) : index = require_index_open index; raw_index_write index.handle; index -let close_index 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 = String.contains blob.bytes '\000' -let blob_text blob = blob.bytes -let shutdown () = libgit2_shutdown () +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 ()
@@ -1,24 +1,24 @@ open Ocaml_git -let work_root = ".build/test-work" -let repo_path = work_root ^ "/demo-repo" +let work_root : string = ".build/test-work" +let repo_path : string = work_root ^ "/demo-repo" -let sh command = +let sh (command : string) : unit = match Sys.command command with | 0 -> () | code -> Alcotest.failf "command failed with %d: %s" code command -let reset_fixture () = +let reset_fixture () : unit = sh ("rm -rf " ^ work_root ^ " && mkdir -p " ^ work_root ^ " && tar -xzf fixtures/demo-repo.tar.gz -C " ^ work_root) -let with_fixture f = +let with_fixture (f : unit -> unit) : unit = reset_fixture (); f () -let check_suffix label suffix value = +let check_suffix (label : string) (suffix : string) (value : string) : unit = Alcotest.(check bool) label true (String.ends_with ~suffix value) -let opens_repository () = with_fixture @@ fun () -> +let opens_repository () : unit = with_fixture @@ fun () -> with_repo repo_path @@ fun repo -> check_suffix "workdir" "demo-repo/" (Option.get (workdir repo)); check_suffix "git_dir" "demo-repo/.git/" (git_dir repo); @@ -26,7 +26,7 @@ let opens_repository () = with_fixture @@ fun () -> Alcotest.(check bool) "not empty" false (is_empty repo); Alcotest.(check string) "head" "refs/heads/main" (head_name repo) -let opens_bare_repository () = with_fixture @@ fun () -> +let opens_bare_repository () : unit = with_fixture @@ fun () -> let path = work_root ^ "/bare-repo.git" in sh ("git clone --bare " ^ repo_path ^ " " ^ path ^ " >/dev/null 2>&1"); with_repo path @@ fun repo -> @@ -35,10 +35,10 @@ let opens_bare_repository () = with_fixture @@ fun () -> Alcotest.(check string) "summary" "Update readme" (head_commit repo).summary; Alcotest.(check bool) "has readme" true (List.exists (fun e -> e.name = "README.md") (tree repo ()).entries) -let discovers_repository_from_child () = with_fixture @@ fun () -> +let discovers_repository_from_child () : unit = with_fixture @@ fun () -> check_suffix "discover" "demo-repo/.git/" (discover (repo_path ^ "/src")) -let reads_head_commit () = with_fixture @@ fun () -> +let reads_head_commit () : unit = with_fixture @@ fun () -> with_repo repo_path @@ fun repo -> let commit = head_commit repo in Alcotest.(check int) "oid length" 40 (String.length commit.id); @@ -48,7 +48,7 @@ let reads_head_commit () = with_fixture @@ fun () -> Alcotest.(check string) "email" "fixture@example.com" commit.author.email; Alcotest.(check int) "parents" 1 commit.parent_count -let lists_branches () = with_fixture @@ fun () -> +let lists_branches () : unit = with_fixture @@ fun () -> with_repo repo_path @@ fun repo -> let branches : branch list = branches repo in let names = List.map (fun (b : branch) -> b.name) branches in @@ -57,11 +57,11 @@ let lists_branches () = with_fixture @@ fun () -> Alcotest.(check bool) "main head" true (List.find (fun (b : branch) -> b.name = "main") branches).is_head; Alcotest.(check bool) "local" true (List.for_all (fun (b : branch) -> b.kind = Local) branches) -let reads_branch_commit () = with_fixture @@ fun () -> +let reads_branch_commit () : unit = with_fixture @@ fun () -> with_repo repo_path @@ fun repo -> Alcotest.(check string) "summary" "Update readme" (branch_commit repo "main").summary -let looks_up_tree_entries () = with_fixture @@ fun () -> +let looks_up_tree_entries () : unit = with_fixture @@ fun () -> with_repo repo_path @@ fun repo -> let readme = tree_entry repo "README.md" in Alcotest.(check string) "name" "README.md" readme.name; @@ -69,7 +69,7 @@ let looks_up_tree_entries () = with_fixture @@ fun () -> Alcotest.(check int) "oid" 40 (String.length readme.id); Alcotest.(check bool) "src tree" true ((tree_entry repo "src").kind = Tree) -let lists_trees () = with_fixture @@ fun () -> +let lists_trees () : unit = with_fixture @@ fun () -> with_repo repo_path @@ fun repo -> let root = tree repo () in Alcotest.(check bool) "readme" true (List.exists (fun e -> e.name = "README.md" && e.kind = Blob) root.entries); @@ -77,24 +77,24 @@ let lists_trees () = with_fixture @@ fun () -> let src = tree ~path:"src" repo () in Alcotest.(check bool) "hello" true (List.exists (fun e -> e.name = "hello.txt" && e.kind = Blob) src.entries) -let reads_blobs () = with_fixture @@ fun () -> +let reads_blobs () : unit = with_fixture @@ fun () -> with_repo repo_path @@ fun repo -> let blob = blob repo "README.md" in Alcotest.(check bool) "text" false (blob_is_binary blob); Alcotest.(check bool) "content" true (String.contains (blob_text blob) 'd') -let walks_commit_history () = with_fixture @@ fun () -> +let walks_commit_history () : unit = with_fixture @@ fun () -> with_repo repo_path @@ fun repo -> let commits = commits repo "main" in Alcotest.(check int) "count" 2 (List.length commits); Alcotest.(check string) "first" "Update readme" (List.hd commits).summary; Alcotest.(check string) "last" "Initial fixture commit" (List.hd (List.rev commits)).summary -let reports_clean_status () = with_fixture @@ fun () -> +let reports_clean_status () : unit = with_fixture @@ fun () -> with_repo repo_path @@ fun repo -> Alcotest.(check int) "clean" 0 (List.length (status repo)) -let reports_worktree_status () = with_fixture @@ fun () -> +let reports_worktree_status () : unit = with_fixture @@ fun () -> sh ("printf '\\nlocal edit\\n' >> " ^ repo_path ^ "/README.md"); sh ("printf 'notes\\n' > " ^ repo_path ^ "/notes.txt"); with_repo repo_path @@ fun repo -> @@ -102,7 +102,7 @@ let reports_worktree_status () = with_fixture @@ fun () -> Alcotest.(check bool) "modified" true (List.mem Worktree_modified (by_path "README.md").flags); Alcotest.(check bool) "new" true (List.mem Worktree_new (by_path "notes.txt").flags) -let updates_index () = with_fixture @@ fun () -> +let updates_index () : unit = with_fixture @@ fun () -> sh ("printf 'notes\\n' > " ^ repo_path ^ "/notes.txt"); with_repo repo_path @@ fun repo -> let idx = index repo in @@ -117,7 +117,7 @@ let updates_index () = with_fixture @@ fun () -> let notes = List.find (fun s -> s.path = "notes.txt") (status repo) in Alcotest.(check bool) "staged" true (List.mem Index_new notes.flags) -let initializes_repository () = with_fixture @@ fun () -> +let initializes_repository () : unit = with_fixture @@ fun () -> let path = work_root ^ "/new-repo" in sh ("rm -rf " ^ path ^ " && mkdir -p " ^ path); let repo = init path in @@ -126,13 +126,13 @@ let initializes_repository () = with_fixture @@ fun () -> Alcotest.(check bool) "empty" true (is_empty repo); check_suffix "new workdir" "new-repo/" (Option.get (workdir repo)) -let rejects_missing_repository () = with_fixture @@ fun () -> +let rejects_missing_repository () : unit = with_fixture @@ fun () -> Alcotest.(check bool) "missing" true (match open_repo (work_root ^ "/missing") with | _ -> false | exception Git_error _ -> true) -let () = +let () : unit = Alcotest.run "ocaml-git" [ ( "repository",