;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; libgit2.scm - libgit2 bindings for Chicken Scheme
;;;
;;; Copyright (c) 2013-2014, Evan Hanson
;;; See LICENSE for details
;;;
;;; See git.scm for a cleaner, high-level API.
;;;

(require-library foreigners lolevel srfi-69)

(module libgit2 ()
  (import scheme foreigners lolevel srfi-69)
  (import foreign)
  (import (except chicken repository-path))
  (include "libgit2-exports.scm")

;; Errors are composite conditions of properties (exn git).
(define (git-error loc msg . args)
  (signal (make-composite-condition
            (make-property-condition 'git)
            (make-property-condition 'exn 'location  loc
                                          'message   msg
                                          'arguments args))))

;; Check the return value of an expression, signaling an error when nonzero.
(define-syntax guard-errors
  (syntax-rules ()
    ((_ <loc> <exp> . <arg>)
     (begin
       (error-clear)
       (let ((res <exp>))
         (if (< res 0)
             (git-error '<loc> (error-last))))))))

;; Create a foreign procedure whose return value should be checked as an
;; integer status.
(define-syntax foreign-lambda/retval
  (lambda (e . _)
    (let* ((name    (cadr e))
           (args    (cddr e))
           (formals (map (compose gensym ->string) args)))
      `(lambda ,formals
         (guard-errors ,name ((foreign-lambda int ,name ,@args) ,@formals) ,@formals)))))

;; Create a foreign procedure that allocates a location for its return
;; value.
(define-syntax foreign-lambda/allocate
  (lambda (e . _)
    (let* ((type    (cadr e))
           (name    (caddr e))
           (args    (cdddr e))
           (formals (map (compose gensym ->string) args))
           (type*   (if (list? type) (last type) type)))
      `(lambda ,formals
         ,(case type*
            ((buf)
             `(let ((buf (make-buf)))
                ((foreign-lambda/retval ,name buf ,@args) buf ,@formals)
                (begin0-let ((out (buf-pointer buf)))
                  ((foreign-lambda void git_buf_free buf) buf))))
            ((oid revspec)
             `(let ((object (,(symbol-append 'make- type))))
                ((foreign-lambda/retval ,name ,type ,@args) object ,@formals)
                object))
            ((strarray)
             `(let-location ((strarray ,type))
                ((foreign-lambda/retval ,name ,type ,@args) (location strarray) ,@formals)
                (strarray-retrieve (location strarray))))
            (else
             `(let-location ((object ,type*))
                ((foreign-lambda/retval ,name (c-pointer ,type) ,@args) (location object) ,@formals)
                object)))))))

(define-syntax define-git-callback
  (syntax-rules ()
    ((_ spec . body)
     (define-external spec int (begin . body) 0))))

(define-syntax begin0-let
  (syntax-rules ()
    ((_ ((n e) . rest) . body)
     (let ((n e) . rest) (begin . body) n))))

(define-inline (copy-memory r n)
  (let ((out (make-blob n)))
    (move-memory! r out n)
    (make-locative out)))

;;;
;;; Callback management.
;;;
;;; We have to make sure procedures passed to C as callbacks aren't
;;; moved by the GC while in use, so we store them in a lookup table and
;;; pass integer keys to the libgit2 functions that need them.
;;;

(define-values (handle->object handle-destroy! make-handle)
  (let ((index 1) ; NB Must start at 1!
        (table (make-hash-table =)))
    (values
     (lambda (i)
       (hash-table-ref table (pointer->address i)))
     (lambda (i)
       (hash-table-delete! table (pointer->address i)))
     (lambda (c)
       (let ((i index))
         (hash-table-set! table i c)
         (set! index (fxmod (fx+ i 1) (fx- most-positive-fixnum 1)))
         (address->pointer i))))))

(define (call-with-handle o f)
  (let ((h #f))
    (dynamic-wind
     (lambda () (set! h (make-handle o)))
     (lambda () (f h))
     (lambda () (handle-destroy! h)))))

(define-syntax let-handle
  (syntax-rules ()
    ((_ () . body)
     (let () . body))
    ((_ ((h e)) . body)
     (call-with-handle e (lambda (h) . body)))
    ((_ ((h e) ...) . body)
     (syntax-error 'let-handle "multiple bindings unsupported"))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; git2.h

(foreign-declare "#include <git2.h>")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; types.h

(define-foreign-type unsigned-int16 unsigned-short)
(define-foreign-type time-t long)
(define-foreign-type off-t long)

(define-foreign-record-type (time git_time)
  (time-t time time-time)
  (int offset time-offset))

(define-foreign-record-type (signature git_signature)
  (c-string name signature-name)
  (c-string email signature-email)
  ((struct time) when signature-time))

(define-foreign-record-type (oid git_oid)
  (unsigned-char (id (foreign-value GIT_OID_RAWSZ int)) oid-id))

(define-foreign-record-type (index-time git_index_time)
  (time-t seconds index-time-seconds)
  (unsigned-int nanoseconds index-time-nanoseconds))

(define-foreign-record-type (index-entry git_index_entry)
  ((struct index-time) ctime index-entry-ctime)
  ((struct index-time) mtime index-entry-mtime)
  (unsigned-int dev index-entry-dev)
  (unsigned-int ino index-entry-ino)
  (unsigned-int mode index-entry-mode)
  (unsigned-int uid index-entry-uid)
  (unsigned-int gid index-entry-gid)
  (off-t file_size index-entry-size)
  ((struct oid) id index-entry-id)
  (unsigned-int flags index-entry-flags)
  (unsigned-int flags_extended index-entry-extended)
  (c-string path index-entry-path))

(define-foreign-enum-type (object-type int)
  (object-type->int int->object-type)
  ((any       object-type/any)       GIT_OBJ_ANY)    ; -2
  ((bad       object-type/bad)       GIT_OBJ_BAD)    ; -1
  ((ext1      object-type/ext1)      GIT_OBJ__EXT1)  ; ...
  ((commit    object-type/commit)    GIT_OBJ_COMMIT)
  ((tree      object-type/tree)      GIT_OBJ_TREE)
  ((blob      object-type/blob)      GIT_OBJ_BLOB)
  ((tag       object-type/tag)       GIT_OBJ_TAG)
  ((ext2      object-type/ext2)      GIT_OBJ__EXT2)
  ((ofs-delta object-type/ofs-delta) GIT_OBJ_OFS_DELTA)
  ((ref-delta object-type/ref-delta) GIT_OBJ_REF_DELTA))

;; Because foreigners defines CHICKEN->C enum conversions as bitwise ORs
;; while the git_otype enum runs from -2 up, we have to manually convert
;; the negative members to avoid signedness confusion on 32-bit systems.
(define-foreign-type object-type int
  (let ((object-type->int object-type->int))
    (lambda (t)
      (case t
        ((any) (foreign-value GIT_OBJ_ANY int))
        ((bad) (foreign-value GIT_OBJ_BAD int))
        (else  (object-type->int t)))))
  int->object-type)

(define-foreign-enum-type (filemode int)
  (filemode->int int->filemode)
  ((new         filemode/new)        GIT_FILEMODE_NEW)
  ((tree        filemode/tree)       GIT_FILEMODE_TREE)
  ((blob        filemode/blob)       GIT_FILEMODE_BLOB)
  ((executable  filemode/executable) GIT_FILEMODE_BLOB_EXECUTABLE)
  ((link        filemode/link)       GIT_FILEMODE_LINK)
  ((commit      filemode/commit)     GIT_FILEMODE_COMMIT))

(define-foreign-type commit           (c-pointer "git_commit"))
(define-foreign-type config           (c-pointer "git_config"))
(define-foreign-type blob*            (c-pointer "git_blob")) ; clash w/ built-in
(define-foreign-type index            (c-pointer "git_index"))
(define-foreign-type iterator         (c-pointer "git_iterator"))
(define-foreign-type object           (c-pointer "git_object"))
(define-foreign-type odb              (c-pointer "git_odb"))
(define-foreign-type odb-object       (c-pointer "git_odb_object"))
(define-foreign-type oid-shorten      (c-pointer "git_oid_shorten"))
(define-foreign-type patch            (c-pointer "git_patch"))
(define-foreign-type push             (c-pointer "git_push"))
(define-foreign-type note             (c-pointer "git_note"))
(define-foreign-type reference        (c-pointer "git_reference"))
(define-foreign-type refspec          (c-pointer "git_refspec"))
(define-foreign-type remote           (c-pointer "git_remote"))
(define-foreign-type remote-callbacks (c-pointer "git_remote_callbacks"))
(define-foreign-type remote-head      (c-pointer "git_remote_head"))
(define-foreign-type repository       (c-pointer "git_repository"))
(define-foreign-type revwalk          (c-pointer "git_revwalk"))
(define-foreign-type tag              (c-pointer "git_tag"))
(define-foreign-type tree             (c-pointer "git_tree"))
(define-foreign-type tree-entry       (c-pointer "git_tree_entry"))
(define-foreign-type tree-builder     (c-pointer "git_treebuilder"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; buffer.h
;;;

(define-foreign-record-type (buf git_buf)
  (c-string ptr buf-pointer buf-pointer-set!)
  (size_t asize buf-asize buf-asize-set!)
  (size_t size buf-size buf-size-set!))

(define (make-buf)
  (begin0-let ((buf (make-locative (make-blob (foreign-type-size "git_buf")))))
    (buf-pointer-set! buf #f)
    (buf-asize-set! buf 0)
    (buf-size-set! buf 0)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; blob.h

(define blob-lookup             (foreign-lambda/allocate blob* git_blob_lookup repository oid))
(define blob-lookup-prefix      (foreign-lambda/allocate blob* git_blob_lookup_prefix repository oid unsigned-int))
(define blob-create-fromdisk    (foreign-lambda/allocate oid git_blob_create_fromdisk repository nonnull-c-string))
(define blob-create-fromworkdir (foreign-lambda/allocate oid git_blob_create_fromworkdir repository nonnull-c-string))
(define blob-create-frombuffer  (foreign-lambda/allocate oid git_blob_create_frombuffer repository nonnull-c-string unsigned-int))
(define blob-id                 (foreign-lambda oid git_blob_id blob*))
(define blob-free               (foreign-lambda void git_blob_free blob*))
(define blob-rawcontent         (foreign-lambda c-pointer git_blob_rawcontent blob*))
(define blob-rawsize            (foreign-lambda size_t git_blob_rawsize blob*))
(define blob-is-binary          (foreign-lambda bool git_blob_is_binary blob*))

(define blob*-lookup             blob-lookup)
(define blob*-create-frombuffer  blob-create-fromdisk)
(define blob*-create-fromdisk    blob-create-fromworkdir)
(define blob*-create-fromworkdir blob-create-frombuffer)
(define blob*-free               blob-free)
(define blob*-id                 blob-id)
(define blob*-is-binary          blob-is-binary)
(define blob*-rawcontent         blob-rawcontent)
(define blob*-rawsize            blob-rawsize)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; branch.h

(define-foreign-type branch-iterator (c-pointer "git_branch_iterator"))

(define-foreign-enum-type (branch-type unsigned-int)
  (branch-type->int int->branch-type)
  ((local   branch-type/local)  GIT_BRANCH_LOCAL)
  ((remote  branch-type/remote) GIT_BRANCH_REMOTE)
  ((all     branch-type/all)    GIT_BRANCH_ALL))

(define branch-lookup       (foreign-lambda/allocate reference git_branch_lookup repository nonnull-c-string branch-type))
(define branch-create       (foreign-lambda/allocate reference git_branch_create repository nonnull-c-string commit bool signature c-string))
(define branch-move         (foreign-lambda/allocate reference git_branch_move reference nonnull-c-string bool signature c-string))
(define branch-upstream     (foreign-lambda/allocate reference git_branch_upstream reference))
(define branch-name         (foreign-lambda/allocate (const c-string) git_branch_name reference))
(define branch-set-upstream (foreign-lambda/retval git_branch_set_upstream reference nonnull-c-string))
(define branch-delete       (foreign-lambda/retval git_branch_delete reference))
(define branch-is-head      (foreign-lambda bool git_branch_is_head reference))

;; Branch iterators.
(define branch-iterator-new  (foreign-lambda/allocate branch-iterator git_branch_iterator_new repository branch-type))
(define branch-iterator-free (foreign-lambda void git_branch_iterator_free branch-iterator))
(define branch-next
  (let ((next (foreign-lambda/allocate reference git_branch_next (c-pointer branch-type) branch-iterator)))
    (lambda (iter)
      (let-location ((t branch-type))
        (let ((b (next (location t) iter)))
          (values b t))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; checkout.h

(define-foreign-record-type (checkout-options git_checkout_options)
  (unsigned-int version checkout-options-version)
  (checkout-strategy checkout_strategy checkout-options-checkout-strategy)
  (int disable_filters checkout-options-disable-filters)
  (unsigned-int dir_mode checkout-options-dir-mode)
  (unsigned-int file_mode checkout-options-file-mode)
  (int file_open_flags checkout-options-file-open-flags)
  (unsigned-int notify_flags checkout-options-notify-flags)
  (c-pointer notify_cb checkout-options-notify-cb) ; TODO (git_checkout_notify_cb notify_cb notify-cb)
  (c-pointer notify_payload checkout-options-notify-payload)
  (c-pointer progress_cb checkout-options-progress-cb) ; TODO (git_checkout_progress_cb progress_cb progress-cb)
  (c-pointer progress_payload checkout-options-progress-payload)
  ((struct strarray) paths checkout-options-paths)
  (tree baseline checkout-options-baseline)
  ((const c-string) target_directory checkout-options-target-directory)
  ((const c-string) ancestor_label checkout-options-ancestor-label)
  ((const c-string) our_label checkout-options-our-label)
  ((const c-string) their_label checkout-options-their-label))

(define-foreign-enum-type (checkout-strategy unsigned-int)
  (checkout-strategy->int int->checkout-strategy)
  ((none)                         GIT_CHECKOUT_NONE)
  ((safe)                         GIT_CHECKOUT_SAFE)
  ((safe-create)                  GIT_CHECKOUT_SAFE_CREATE)
  ((force)                        GIT_CHECKOUT_FORCE)
  ((allow-conflicts)              GIT_CHECKOUT_ALLOW_CONFLICTS)
  ((remove-untracked)             GIT_CHECKOUT_REMOVE_UNTRACKED)
  ((remove-ignored)               GIT_CHECKOUT_REMOVE_IGNORED)
  ((update-only)                  GIT_CHECKOUT_UPDATE_ONLY)
  ((dont-update-index)            GIT_CHECKOUT_DONT_UPDATE_INDEX)
  ((no-refresh)                   GIT_CHECKOUT_NO_REFRESH)
  ((disable-pathspec-match)       GIT_CHECKOUT_DISABLE_PATHSPEC_MATCH)
  ((skip-locked-directories)      GIT_CHECKOUT_SKIP_LOCKED_DIRECTORIES)
  ((skip-unmerged)                GIT_CHECKOUT_SKIP_UNMERGED)
  ((use-ours)                     GIT_CHECKOUT_USE_OURS)
  ((use-theirs)                   GIT_CHECKOUT_USE_THEIRS)
  ((update-submodules)            GIT_CHECKOUT_UPDATE_SUBMODULES)
  ((update-submodules-if-changed) GIT_CHECKOUT_UPDATE_SUBMODULES_IF_CHANGED))

(foreign-declare
  "git_checkout_options chicken_git_default_checkout_options =
    {GIT_CHECKOUT_OPTIONS_VERSION, GIT_CHECKOUT_FORCE};")

(define checkout-options-default
  (foreign-value "&chicken_git_default_checkout_options" checkout-options))

(define checkout-head  (foreign-lambda/retval git_checkout_head repository checkout-options))
(define checkout-index (foreign-lambda/retval git_checkout_index repository index checkout-options))
(define checkout-tree  (foreign-lambda/retval git_checkout_tree repository object checkout-options))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; commit.h

(define commit-lookup           (foreign-lambda/allocate commit git_commit_lookup repository oid))
(define commit-lookup-prefix    (foreign-lambda/allocate commit git_commit_lookup_prefix repository oid unsigned-int))
(define commit-tree             (foreign-lambda/allocate tree git_commit_tree commit))
(define commit-parent           (foreign-lambda/allocate commit git_commit_parent commit unsigned-int))
(define commit-nth-gen-ancestor (foreign-lambda/allocate commit git_commit_nth_gen_ancestor commit unsigned-int))
(define commit-free             (foreign-lambda void git_commit_free commit))
(define commit-id               (foreign-lambda oid git_commit_id commit))
(define commit-message          (foreign-lambda c-string git_commit_message commit))
(define commit-message-raw      (foreign-lambda c-string git_commit_message_raw commit))
(define commit-message-encoding (foreign-lambda c-string git_commit_message_encoding commit))
(define commit-time             (foreign-lambda time-t git_commit_time commit))
(define commit-time-offset      (foreign-lambda int git_commit_time_offset commit))
(define commit-raw-header       (foreign-lambda c-string git_commit_raw_header commit))
(define commit-committer        (foreign-lambda signature git_commit_committer commit))
(define commit-author           (foreign-lambda signature git_commit_author commit))
(define commit-tree-id          (foreign-lambda oid git_commit_tree_id commit))
(define commit-parentcount      (foreign-lambda unsigned-int git_commit_parentcount commit))
(define commit-parent-id        (foreign-lambda oid git_commit_parent_id commit unsigned-int))

(define pack-commit-pointer-array
  (foreign-lambda* (c-pointer commit) ((scheme-object ptrs) (int len))
   "int i;
    C_word iter;
    git_commit **out = malloc(sizeof(git_commit *) * len);
    for(i = 0, iter = ptrs; i < len; i++, iter = C_u_i_cdr(iter))
      out[i] = (git_commit *) C_pointer_address(C_u_i_car(iter));
    C_return(out);"))

(define (commit-create repo ref author commit msg tree parents)
  (let* ((parent-count (length parents))
         (parent-array (pack-commit-pointer-array parents parent-count))
         (commit-oid
          ((foreign-lambda/allocate oid git_commit_create
            repository c-string signature signature c-string nonnull-c-string tree int          (c-pointer (const commit)))
            repo       ref      author    commit    #f       msg              tree parent-count parent-array)))
    (free parent-array)
    commit-oid))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; common.h

(define-foreign-record-type (strarray git_strarray)
  ((c-pointer c-string) strings strarray-strings)
  (unsigned-int count strarray-count))

;; Get a GC'd list of strings from a strarray.
(define strarray-retrieve
  (foreign-lambda* c-string-list* ((strarray sa))
    "int i, l;
     char **t = malloc(sizeof(char *) * (sa->count + 1));
     for(i = 0; i < sa->count; i++) {
       t[i] = malloc((l = strlen(sa->strings[i]) + 1));
       strncpy(t[i], sa->strings[i], l);
     }
     t[i] = NULL;
     git_strarray_free(sa);
     C_return(t);"))

(define (libgit2-version)
  (let-location ((major int) (minor int) (rev int))
    ((foreign-lambda void git_libgit2_version (c-pointer int) (c-pointer int) (c-pointer int))
     (location major)
     (location minor)
     (location rev))
    (vector major minor rev)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; clone.h

(define-foreign-type clone-options (c-pointer "git_clone_options"))

(define clone (foreign-lambda/allocate repository git_clone nonnull-c-string nonnull-c-string clone-options))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; config.h

(define-foreign-record-type (config-entry git_config_entry)
  ((const c-string) name  config-entry-name)
  ((const c-string) value config-entry-value)
  (unsigned-int     level config-entry-level))

(define config-free            (foreign-lambda void git_config_free config))
(define config-new             (foreign-lambda/allocate config git_config_new))
(define config-delete-entry    (foreign-lambda/retval git_config_delete_entry config nonnull-c-string))
(define config-add-file-ondisk (foreign-lambda/retval git_config_add_file_ondisk config nonnull-c-string unsigned-int int))
(define config-open-ondisk     (foreign-lambda/allocate config git_config_open_ondisk nonnull-c-string))
(define config-open-default    (foreign-lambda/allocate config git_config_open_default))
(define config-find-global     (foreign-lambda/allocate buf git_config_find_global))
(define config-find-system     (foreign-lambda/allocate buf git_config_find_system))
(define config-find-xdg        (foreign-lambda/allocate buf git_config_find_xdg))

(define-syntax foreign-lambda/config
  (syntax-rules (getter setter)
    ((_ getter (<qual> ... <type>) <cfun>)
     (lambda (cfg name)
       (let-location ((out <type>))
         ((foreign-lambda/retval <cfun> (c-pointer (<qual> ... <type>)) config (const nonnull-c-string))
                                        (location out)                  cfg    name)
         out)))
    ((_ getter <type> <cfun>)
     (lambda (cfg name)
       (let-location ((out <type>))
         ((foreign-lambda/retval <cfun> (c-pointer <type>) config (const nonnull-c-string))
                                        (location out)     cfg    name)
         out)))
    ((_ setter <type> <cfun>)
     (foreign-lambda/retval <cfun> config (const nonnull-c-string) <type>))))

(define config-get-entry  (foreign-lambda/config getter (const config-entry) git_config_get_entry))
(define config-get-string (foreign-lambda/config getter (const c-string)     git_config_get_string))
(define config-get-int32  (foreign-lambda/config getter integer32            git_config_get_int32))
(define config-get-int64  (foreign-lambda/config getter integer64            git_config_get_int64))
(define config-get-bool   (foreign-lambda/config getter bool                 git_config_get_bool))
(define config-set-string (foreign-lambda/config setter c-string             git_config_set_string))
(define config-set-int32  (foreign-lambda/config setter integer32            git_config_set_int32))
(define config-set-int64  (foreign-lambda/config setter integer64            git_config_set_int64))
(define config-set-bool   (foreign-lambda/config setter bool                 git_config_set_bool))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; diff.h

(define-foreign-type diff (c-pointer "git_diff"))
(define-foreign-type diff-file-fn (c-pointer "git_diff_file_fn"))

(define-foreign-enum-type (diff-find-t int)
  (diff-find-t->int int->diff-find-t)
  ;; look for renames? (`--find-renames`)
  ((find-renames) GIT_DIFF_FIND_RENAMES)
  ;; consider old side of modified for renames? (`--break-rewrites=N`)
  ((find-renames-from-rewrites) GIT_DIFF_FIND_RENAMES_FROM_REWRITES)
  ;; look for copies? (a la `--find-copies`)
  ((find-copies) GIT_DIFF_FIND_COPIES)
  ;; consider unmodified as copy sources? (`--find-copies-harder`)
  ((find-copies-from-unmodifies) GIT_DIFF_FIND_COPIES_FROM_UNMODIFIED)
  ;; mark large rewrites for split (`--break-rewrites=/M`)
  ((find-rewrites) GIT_DIFF_FIND_REWRITES)
  ;; actually split large rewrites into delete/add pairs
  ((break-rewrites) GIT_DIFF_BREAK_REWRITES)
  ;; mark rewrites for split and break into delete/add pairs
  ((find-and-break-rewrites) GIT_DIFF_FIND_AND_BREAK_REWRITES)
  ;; find renames/copies for untracked items in working directory */
  ((find-for-untracked )GIT_DIFF_FIND_FOR_UNTRACKED)
  ;; turn on all finding features
  ((find-all) GIT_DIFF_FIND_ALL)
  ;; measure similarity ignoring leading whitespace (default)
  ((find-ignore-leading-whitespace) GIT_DIFF_FIND_IGNORE_LEADING_WHITESPACE)
  ;; measure similarity ignoring all whitespace
  ((find-ignore-whitespace) GIT_DIFF_FIND_IGNORE_WHITESPACE)
  ;; measure similarity including all data
  ((find-dont-ignore-whitespace) GIT_DIFF_FIND_DONT_IGNORE_WHITESPACE)
  ;; measure similarity only by comparing SHAs (fast and cheap)
  ((find-exact-match-only) GIT_DIFF_FIND_EXACT_MATCH_ONLY)
  ;; do not break rewrites unless they contribute to a rename
  ((break-rewrites-for-renames-only) GIT_DIFF_BREAK_REWRITES_FOR_RENAMES_ONLY))

(define-foreign-record-type (diff-find-options git_diff_find_options)
  (unsigned-int version diff-find-options-version diff-find-options-version-set!)
  ;; Combination of git_diff_find_t values (default FIND_RENAMES)
  (diff-find-t flags diff-find-options-flags diff-find-options-flags-set!) ; unsigned-int32
  ;; Similarity to consider a file renamed (default 50)
  (unsigned-int16 rename_threshold diff-find-options-rename-threshold)
  ;; Similarity of modified to be eligible rename source (default 50)
  (unsigned-int16 rename_from_rewrite_threshold diff-find-options-rename-from-rewrite-threshold)
  ;; Similarity to consider a file a copy (default 50)
  (unsigned-int16 copy_threshold diff-find-options-copy-threshold)
  ;; Similarity to split modify into delete/add pair (default 60)
  (unsigned-int16 break_rewrite_threshold diff-find-options-rewrite-threshold)
  ;; Maximum similarity sources to examine for a file (somewhat like
  ;; git-diff's `-l` option or `diff.renameLimit` config) (default 200)
  (size_t rename_limit diff-find-options-rename-limit)
  ;; Pluggable similarity metric; pass NULL to use internal metric
  (c-pointer metric diff-find-options-metric)) ; git_diff_similarity_metric

(define-foreign-enum-type (diff-line char)
  (diff-line->char char->diff-line)
  ((context   diff-line/context)   GIT_DIFF_LINE_CONTEXT)
  ((addition  diff-line/addition)  GIT_DIFF_LINE_ADDITION)
  ((deletion  diff-line/deletion)  GIT_DIFF_LINE_DELETION)
  ((add-eofnl diff-line/add-eofnl) GIT_DIFF_LINE_ADD_EOFNL)
  ((del-eofnl diff-line/del-eofnl) GIT_DIFF_LINE_DEL_EOFNL)
  ((file-hdr  diff-line/file-hdr)  GIT_DIFF_LINE_FILE_HDR)
  ((hunk-hdr  diff-line/hunk-hdr)  GIT_DIFF_LINE_HUNK_HDR)
  ((binary    diff-line/binary)    GIT_DIFF_LINE_BINARY))

(define-foreign-enum-type (delta int)
  (delta->int int->delta)
  ((modified  diff/unmodified) GIT_DELTA_UNMODIFIED)
  ((added     diff/added)      GIT_DELTA_ADDED)
  ((deleted   diff/deleted)    GIT_DELTA_DELETED)
  ((modified  diff/modified)   GIT_DELTA_MODIFIED)
  ((renamed   diff/renamed)    GIT_DELTA_RENAMED)
  ((copied    diff/copied)     GIT_DELTA_COPIED)
  ((ignored   diff/ignored)    GIT_DELTA_IGNORED)
  ((untracked diff/untracked)  GIT_DELTA_UNTRACKED))

(define-foreign-record-type (diff-options git_diff_options)
  (unsigned-int32    flags           diff-options-flags           diff-options-flags-set!)
  (unsigned-int16    context_lines   diff-options-context-lines   diff-options-context-lines-set!)
  (unsigned-int16    interhunk_lines diff-options-interhunk-lines diff-options-interhunk-lines-set!)
  (c-string          old_prefix      diff-options-old-prefix      diff-options-old-prefix-set!)
  (c-string          new_prefix      diff-options-new-prefix      diff-options-new-prefix-set!)
  ((struct strarray) pathspec        diff-options-pathspec        diff-options-pathspec-set!))

(define-foreign-record-type (diff-file git_diff_file)
  ((struct oid)   id     diff-file-id)
  (c-string       path   diff-file-path)
  (off-t          size   diff-file-size)
  (unsigned-int32 flags  diff-file-flags)
  (unsigned-int16 mode   diff-file-mode))

(define-foreign-record-type (diff-delta git_diff_delta)
  (delta              status     diff-delta-status)
  (unsigned-int32     flags      diff-delta-flags)
  (unsigned-int16     similarity diff-delta-similarity)
  (unsigned-int16     nfiles     diff-delta-nfiles)
  ((struct diff-file) old_file   diff-delta-old-file)
  ((struct diff-file) new_file   diff-delta-new-file))

(define-foreign-record-type (diff-hunk git_diff_hunk)
  (int              old_start    diff-hunk-old-start)
  (int              old_lines    diff-hunk-old-lines)
  (int              new_start    diff-hunk-new-start)
  (int              new_lines    diff-hunk-new-lines)
  (size_t           header_len   diff-hunk-header-length)
  (nonnull-c-string header       diff-hunk-header))

(define-foreign-record-type (diff-line git_diff_line)
  (char             origin         diff-line-origin)
  (int              old_lineno     diff-line-old-lineno)
  (int              new_lineno     diff-line-new-lineno)
  (int              num_lines      diff-line-num-lines)
  (size_t           content_len    diff-line-content-length)
  (off-t            content_offset diff-line-content-offset)
  ;; XXX Not null-terminated, and doesn't outlive the call to
  ;; git_diff_line_cb that produces it -- must be copied out first.
  (c-pointer        content        diff-line-content))

(define diff-merge        (foreign-lambda/retval git_diff_merge diff diff))
(define diff-find-similar (foreign-lambda/retval git_diff_find_similar diff diff-find-options))
(define diff-num-deltas   (foreign-lambda size_t git_diff_num_deltas diff))
(define diff-num-deltas-of-type (foreign-lambda size_t git_diff_num_deltas_of_type diff delta))
(define diff-free         (foreign-lambda void git_diff_free diff))

(define-syntax foreign-lambda/diff
  (lambda (e . _)
    (let* ((name  (cadr e))
           (types (cddr e))
           (args  (map gensym types)))
      `(lambda (repo ,@args)
         (let-location ((diff diff))
           ((foreign-lambda/retval ,name
            (c-pointer diff) repository ,@types diff-options)
            (location diff)  repo       ,@args  #f)
           diff)))))

(define diff-tree-to-tree     (foreign-lambda/diff git_diff_tree_to_tree tree tree))
(define diff-tree-to-index    (foreign-lambda/diff git_diff_tree_to_index tree index))
(define diff-index-to-workdir (foreign-lambda/diff git_diff_index_to_workdir index))
(define diff-tree-to-workdir  (foreign-lambda/diff git_diff_tree_to_workdir tree))

(define-foreign-type diff-file-cb (function int ((const diff-delta) float c-pointer)))
(define-git-callback (diff_file_cb (diff-delta delta) (float progress) (c-pointer i))
  (and-let* ((f (vector-ref (handle->object i) 0)))
    (f delta)))

(define-foreign-type diff-hunk-cb (function int ((const diff-delta) (const diff-hunk) c-pointer)))
(define-git-callback (diff_hunk_cb (diff-delta delta) (diff-hunk hunk) (c-pointer i))
  (and-let* ((f (vector-ref (handle->object i) 1)))
    (f delta (copy-memory hunk (foreign-type-size "git_diff_hunk")))))

(define-foreign-type diff-line-cb (function int ((const diff-delta) (const diff-hunk) (const diff-line) c-pointer)))
(define-git-callback (diff_line_cb (diff-delta delta) (diff-hunk hunk) (diff-line line) (c-pointer i))
  (and-let* ((f (vector-ref (handle->object i) 2)))
    (f delta hunk (copy-memory line (foreign-type-size "git_diff_line")))))

(define (diff-foreach file hunk line diff)
  (let-handle ((callbacks (vector file hunk line)))
    (guard-errors git_diff_foreach
     ((foreign-safe-lambda int git_diff_foreach
       diff diff-file-cb            diff-hunk-cb            diff-line-cb            c-pointer)
       diff (location diff_file_cb) (location diff_hunk_cb) (location diff_line_cb) callbacks))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; errors.h

(define-foreign-record-type (error git_error)
  (c-string message error-message)
  (int      klass   error-class))

(define-foreign-enum-type (generic-error int)
  (generic-error->int int->generic-error)
  ((ok             err/ok)             GIT_OK)
  ((error          err/error)          GIT_ERROR)
  ((notfound       err/notfound)       GIT_ENOTFOUND)
  ((exists         err/exists)         GIT_EEXISTS)
  ((ambiguous      err/ambiguous)      GIT_EAMBIGUOUS)
  ((bufs           err/bufs)           GIT_EBUFS)
  ((user           err/user)           GIT_EUSER)
  ((barerepo       err/barerepo)       GIT_EBAREREPO)
  ((orphanedhead   err/orphanedhead)   GIT_EORPHANEDHEAD)
  ((nonfastforward err/nonfastforward) GIT_ENONFASTFORWARD)
  ((invalidspec    err/invalidspec)    GIT_EINVALIDSPEC)
  ((mergeconflict  err/mergeconflict)  GIT_EMERGECONFLICT)
  ((passthrough    err/passthrough)    GIT_PASSTHROUGH)
  ((iterover       err/iterover)       GIT_ITEROVER))

(define-foreign-enum-type (error-type int)
  (error-type->int int->error-type)
  ((nomemory   err/nomemory)   GITERR_NOMEMORY)
  ((os         err/os)         GITERR_OS)
  ((invalid    err/invalid)    GITERR_INVALID)
  ((reference  err/reference)  GITERR_REFERENCE)
  ((zlib       err/zlib)       GITERR_ZLIB)
  ((repository err/repository) GITERR_REPOSITORY)
  ((config     err/config)     GITERR_CONFIG)
  ((regex      err/regex)      GITERR_REGEX)
  ((odb        err/odb)        GITERR_ODB)
  ((index      err/index)      GITERR_INDEX)
  ((object     err/object)     GITERR_OBJECT)
  ((net        err/net)        GITERR_NET)
  ((tag        err/tag)        GITERR_TAG)
  ((tree       err/tree)       GITERR_TREE)
  ((indexer    err/indexer)    GITERR_INDEXER)
  ((ssl        err/ssl)        GITERR_SSL)
  ((submodule  err/submodule)  GITERR_SUBMODULE)
  ((thread     err/thread)     GITERR_THREAD)
  ((stash      err/stash)      GITERR_STASH)
  ((checkout   err/checkout)   GITERR_CHECKOUT)
  ((fetchhead  err/fetchhead)  GITERR_FETCHHEAD)
  ((merge      err/merge)      GITERR_MERGE))

(define error-clear (foreign-lambda void giterr_clear))

(define (error-last)
  (and-let* ((err ((foreign-lambda (c-pointer error) giterr_last))))
    (error-message err)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ignore.h
;;;

(define ignore-add-rule (foreign-lambda/retval git_ignore_add_rule repository nonnull-c-string))
(define ignore-clear-internal-rules (foreign-lambda/retval git_ignore_clear_internal_rules repository))
(define ignore-path-is-ignored (foreign-lambda/allocate bool git_ignore_path_is_ignored repository nonnull-c-string))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; index.h

(define index-open             (foreign-lambda/allocate index git_index_open nonnull-c-string))
(define index-write-tree       (foreign-lambda/allocate oid git_index_write_tree index))
(define index-write-tree-to    (foreign-lambda/allocate oid git_index_write_tree_to index repository))
(define index-read             (foreign-lambda/retval git_index_read index bool))
(define index-write            (foreign-lambda/retval git_index_write index))
(define index-add              (foreign-lambda/retval git_index_add index index-entry))
(define index-add-bypath       (foreign-lambda/retval git_index_add_bypath index nonnull-c-string))
(define index-remove           (foreign-lambda/retval git_index_remove index nonnull-c-string int))
(define index-remove-directory (foreign-lambda/retval git_index_remove_directory index nonnull-c-string int))
(define index-owner            (foreign-lambda repository git_index_owner index))
(define index-clear            (foreign-lambda void git_index_clear index))
(define index-free             (foreign-lambda void git_index_free index))
(define index-find             (foreign-lambda int git_index_find (c-pointer size_t) index nonnull-c-string))
(define index-get-bypath       (foreign-lambda index-entry git_index_get_bypath index nonnull-c-string int))
(define index-get-byindex      (foreign-lambda index-entry git_index_get_byindex index size_t))
(define index-entrycount       (foreign-lambda unsigned-int git_index_entrycount index))
(define index-entry-stage      (foreign-lambda int git_index_entry_stage index-entry))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; indexer.h

(define-foreign-record-type (transfer-progress git_transfer_progress)
  (unsigned-int total_objects    transfer-progress-total-objects)
  (unsigned-int indexed_objects  transfer-progress-indexed-objects)
  (unsigned-int received_objects transfer-progress-received-objects)
  (size_t       received_bytes   transfer-progress-received-bytes))

(define-foreign-type transfer-progress-cb (function int ((const transfer-progress) c-pointer)))
(define-git-callback (transfer_progress_cb (transfer-progress stats) (c-pointer i))
  ((handle->object i) stats))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; merge.h

(define merge-base (foreign-lambda/allocate oid git_merge_base repository oid oid))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; notes.h

(define note-create  (foreign-lambda/allocate oid git_note_create repository signature signature c-string oid nonnull-c-string bool))
(define note-read    (foreign-lambda/allocate note git_note_read repository c-string oid))
(define note-remove  (foreign-lambda/retval git_note_remove repository c-string signature signature oid))
(define note-message (foreign-lambda c-string git_note_message note))
(define note-id      (foreign-lambda oid git_note_id note))
(define note-free    (foreign-lambda void git_note_free note))

(define (note-default-ref repo)
  (let-location ((str c-string))
    ((foreign-lambda/retval git_note_default_ref (c-pointer (const c-string)) repository) (location str) repo)
    str))

(define-foreign-type note-foreach-cb (function int ((const oid) (const oid) c-pointer)))
(define-git-callback (note_foreach_cb (oid bid) (oid oid) (c-pointer i))
  ((handle->object i) bid oid))

(define (note-foreach repo ref f)
  (let-handle ((callback f))
    (guard-errors git_note_foreach
     ((foreign-safe-lambda int git_note_foreach
       repository c-string note-foreach-cb            c-pointer)
       repo       ref      (location note_foreach_cb) callback))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; object.h

(define object-lookup      (foreign-lambda/allocate object git_object_lookup repository oid object-type))
(define object-id          (foreign-lambda oid git_object_id object))
(define object-free        (foreign-lambda void git_object_free object))
(define object-owner       (foreign-lambda repository git_object_owner object))
(define object-type        (foreign-lambda object-type git_object_type object))
(define object-type2string (foreign-lambda object-type git_object_type2string object-type))
(define object-string2type (foreign-lambda object-type git_object_string2type nonnull-c-string))
(define object-typeisloose (foreign-lambda bool git_object_typeisloose object-type))

(define object-lookup-bypath
  (foreign-lambda/allocate object git_object_lookup_bypath object nonnull-c-string object-type))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; odb_backend.h
;;
;; TODO

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; odb.h
;;
;; TODO git_odb_add_backend git_odb_add_alternate git_odb_read_header
;;      git_odb_open_wstream git_odb_open_rstream

(define odb-new          (foreign-lambda/allocate odb git_odb_new))
(define odb-open         (foreign-lambda/allocate odb git_odb_open nonnull-c-string))
(define odb-read         (foreign-lambda/allocate odb-object git_odb_read odb oid))
(define odb-read-prefix  (foreign-lambda/allocate odb-object git_odb_read_prefix odb oid unsigned-int))
(define odb-write        (foreign-lambda/allocate oid git_odb_write odb scheme-pointer size_t object-type))
(define odb-hash         (foreign-lambda/allocate oid git_odb_hash scheme-pointer size_t object-type))
(define odb-free         (foreign-lambda void git_odb_free odb))
(define odb-exists       (foreign-lambda bool git_odb_exists odb oid))
(define odb-object-free  (foreign-lambda void git_odb_object_free odb-object))
(define odb-object-id    (foreign-lambda oid git_odb_object_id odb-object))
(define odb-object-data  (foreign-lambda c-pointer git_odb_object_data odb-object))
(define odb-object-size  (foreign-lambda size_t git_odb_object_size odb-object))
(define odb-object-type  (foreign-lambda object-type git_odb_object_type odb-object))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; oid.h

(define oid-fromstr      (foreign-lambda/allocate oid git_oid_fromstr nonnull-c-string))
(define oid-shorten-add  (foreign-lambda/retval git_oid_shorten_add oid-shorten nonnull-c-string))
(define oid-cmp          (foreign-lambda int git_oid_cmp oid oid))
(define oid-ncmp         (foreign-lambda int git_oid_ncmp oid oid unsigned-int))
(define oid-equal        (foreign-lambda bool git_oid_equal oid oid))
(define oid-iszero       (foreign-lambda bool git_oid_iszero oid))
(define oid-shorten-new  (foreign-lambda oid-shorten git_oid_shorten_new size_t))
(define oid-shorten-free (foreign-lambda void git_oid_shorten_free oid-shorten))
(define oid-allocfmt     (foreign-lambda c-string git_oid_allocfmt oid))

(define (make-oid)
  (make-locative (make-blob (foreign-value GIT_OID_RAWSZ int))))

(define (oid-cpy oid1)
  (let ((oid2 (make-oid)))
    ((foreign-lambda void git_oid_cpy oid oid) oid2 oid1)
    oid2))

(define (oid-fmt oid)
  (let ((str (make-string 40)))
    ((foreign-lambda void git_oid_fmt scheme-pointer oid) str oid)
    str))

(define (oid-pathfmt oid)
  (let ((str (make-string 41)))
    ((foreign-lambda void git_oid_pathfmt scheme-pointer oid) str oid)
    str))

(define (oid-tostr n id)
  (let ((str (make-string (max n 1))))
    ((foreign-lambda c-string git_oid_tostr
      scheme-pointer size_t  oid)
      str            (+ n 1) id)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; patch.h
;;;

(define patch-free       (foreign-lambda void git_patch_free patch))
(define patch-from-diff  (foreign-lambda/allocate patch git_patch_from_diff diff size_t))
(define patch-from-blobs (foreign-lambda/allocate patch git_patch_from_blobs blob* c-string blob* c-string diff-options))
(define patch-get-delta  (foreign-lambda diff-delta git_patch_get_delta patch))
(define patch-get-hunk   (foreign-lambda/allocate (const diff-hunk) git_patch_get_hunk (c-pointer size_t) patch size_t))
(define patch-num-hunks  (foreign-lambda size_t git_patch_num_hunks patch))
(define patch-size       (foreign-lambda size_t git_patch_size patch bool bool bool))
(define patch-to-buf     (foreign-lambda/allocate buf git_patch_to_buf patch))

(define patch-get-line-in-hunk  (foreign-lambda/allocate (const diff-line) git_patch_get_line_in_hunk patch size_t size_t))
(define patch-num-lines-in-hunk (foreign-lambda int git_patch_num_lines_in_hunk patch size_t))

(define patch-from-blob-and-buffer
  (foreign-lambda/allocate patch git_patch_from_blob_and_buffer blob* c-string c-pointer size_t c-string diff-options))

(define (patch-line-stats patch)
  (let-location ((context   size_t)
                 (additions size_t)
                 (deletions size_t))
    ((foreign-lambda/retval git_patch_line_stats
      (c-pointer size_t) (c-pointer size_t)   (c-pointer size_t)   patch)
      (location context) (location additions) (location deletions) patch)
    (vector context additions deletions)))

;(define patch-print (foreign-lambda/retval git_patch_print ...))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; reflog.h
;;
;; TODO

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; refs.h

(define-foreign-enum-type (reference-type int)
  (ref-type->int int->ref-type)
  ((invalid  reference-type/invalid)  GIT_REF_INVALID)
  ((oid      reference-type/oid)      GIT_REF_OID)
  ((symbolic reference-type/symbolic) GIT_REF_SYMBOLIC)
  ((all      reference-type/all)      GIT_REF_LISTALL))

(define reference-list                (foreign-lambda/allocate strarray git_reference_list repository))
(define reference-lookup              (foreign-lambda/allocate reference git_reference_lookup repository nonnull-c-string))
(define reference-dwim                (foreign-lambda/allocate reference git_reference_dwim repository nonnull-c-string))
(define reference-symbolic-create     (foreign-lambda/allocate reference git_reference_symbolic_create repository nonnull-c-string nonnull-c-string bool signature c-string))
(define reference-create              (foreign-lambda/allocate reference git_reference_create repository nonnull-c-string oid bool signature c-string))
(define reference-name-to-id          (foreign-lambda/allocate oid git_reference_name_to_id repository nonnull-c-string))
(define reference-resolve             (foreign-lambda/allocate reference git_reference_resolve reference))
(define reference-rename              (foreign-lambda/allocate reference git_reference_rename reference nonnull-c-string bool signature c-string))
(define reference-set-target          (foreign-lambda/allocate reference git_reference_set_target reference oid signature c-string))
(define reference-symbolic-set-target (foreign-lambda/allocate reference git_reference_symbolic_set_target reference nonnull-c-string signature c-string))
(define reference-delete              (foreign-lambda/retval git_reference_delete reference))
(define reference-target              (foreign-lambda oid git_reference_target reference))
(define reference-free                (foreign-lambda void git_reference_free reference))
(define reference-type                (foreign-lambda reference-type git_reference_type reference))
(define reference-name                (foreign-lambda c-string git_reference_name reference))
(define reference-owner               (foreign-lambda repository git_reference_owner reference))
(define reference-is-branch           (foreign-lambda bool git_reference_is_branch reference))
(define reference-is-remote           (foreign-lambda bool git_reference_is_remote reference))
(define reference-is-tag              (foreign-lambda bool git_reference_is_tag reference))

(define-foreign-type reference-foreach-name-cb (function int ((const c-string) c-pointer)))
(define-git-callback (reference_foreach_name_cb (c-string name) (c-pointer i))
  ((handle->object i) name))

(define (reference-foreach-name repo f)
  (let-handle ((callback f))
    (guard-errors git_reference_foreach_name
     ((foreign-safe-lambda int git_reference_foreach_name
       repository reference-foreach-name-cb            c-pointer)
       repo       (location reference_foreach_name_cb) callback))))

(define (reference-foreach-glob repo glob f)
  (let-handle ((callback f))
    (guard-errors git_reference_foreach_name
     ((foreign-safe-lambda int git_reference_foreach_glob
       repository nonnull-c-string reference-foreach-name-cb            c-pointer)
       repo       glob             (location reference_foreach_name_cb) callback))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; refspec.h

(define-foreign-enum-type (direction int)
  (direction->int int->direction)
  ((fetch dir/fetch) GIT_DIRECTION_FETCH)
  ((push  dir/push)  GIT_DIRECTION_PUSH))

(define refspec-src         (foreign-lambda c-string git_refspec_src refspec))
(define refspec-dst         (foreign-lambda c-string git_refspec_dst refspec))
(define refspec-string      (foreign-lambda c-string git_refspec_string refspec))
(define refspec-direction   (foreign-lambda direction git_refspec_direction refspec))
(define refspec-force       (foreign-lambda bool git_refspec_force refspec))
(define refspec-src-matches (foreign-lambda bool git_refspec_src_matches refspec nonnull-c-string))
(define refspec-dst-matches (foreign-lambda bool git_refspec_dst_matches refspec nonnull-c-string))

;; TODO git_refspec_transform

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; repository.h

(define repository-open          (foreign-lambda/allocate repository git_repository_open nonnull-c-string))
(define repository-init          (foreign-lambda/allocate repository git_repository_init nonnull-c-string bool))
(define repository-index         (foreign-lambda/allocate index git_repository_index repository))
(define repository-odb           (foreign-lambda/allocate odb git_repository_odb repository))
(define repository-head          (foreign-lambda/allocate reference git_repository_head repository))
(define repository-config        (foreign-lambda/allocate config git_repository_config repository))
(define repository-discover      (foreign-lambda/allocate buf git_repository_discover nonnull-c-string bool c-string))
(define repository-free          (foreign-lambda void git_repository_free repository))
(define repository-is-empty      (foreign-lambda bool git_repository_is_empty repository))
(define repository-is-bare       (foreign-lambda bool git_repository_is_bare repository))
(define repository-path          (foreign-lambda c-string git_repository_path repository))
(define repository-workdir       (foreign-lambda c-string git_repository_workdir repository))
(define repository-head-detached (foreign-lambda bool git_repository_head_detached repository))
(define repository-head-unborn   (foreign-lambda bool git_repository_head_unborn repository))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; remote.h/net.h

(define-foreign-record-type (remote-head git_remote_head)
  (bool         local remote-head-local?)
  ((struct oid) oid   remote-head-id)
  ((struct oid) loid  remote-head-local-id)
  (c-string     name  remote-head-name))

(define remote-add-fetch            (foreign-lambda/retval git_remote_add_fetch remote nonnull-c-string))
(define remote-add-push             (foreign-lambda/retval git_remote_add_push remote nonnull-c-string))
(define remote-fetch                (foreign-lambda/retval git_remote_fetch remote signature c-string))
(define remote-list                 (foreign-lambda/allocate strarray git_remote_list repository))
(define remote-get-push-refspecs    (foreign-lambda/allocate strarray git_remote_get_push_refspecs remote))
(define remote-get-fetch-refspecs   (foreign-lambda/allocate strarray git_remote_get_fetch_refspecs remote))
(define remote-load                 (foreign-lambda/allocate remote git_remote_load repository nonnull-c-string))
(define remote-create               (foreign-lambda/allocate remote git_remote_create repository nonnull-c-string nonnull-c-string))
(define remote-create-inmemory      (foreign-lambda/allocate remote git_remote_create_inmemory repository nonnull-c-string nonnull-c-string))
(define remote-get-refspec          (foreign-lambda refspec git_remote_get_refspec remote int))
(define remote-connect              (foreign-lambda/retval git_remote_connect remote direction))
(define remote-download             (foreign-lambda/retval git_remote_download remote))
(define remote-save                 (foreign-lambda/retval git_remote_save remote))
(define remote-set-url              (foreign-lambda/retval git_remote_set_url remote nonnull-c-string))
(define remote-set-pushurl          (foreign-lambda/retval git_remote_set_pushurl remote nonnull-c-string))
(define remote-update-tips          (foreign-lambda/retval git_remote_update_tips remote signature c-string))
(define remote-update-fetchhead     (foreign-lambda/retval git_remote_update_fetchhead remote))
(define remote-clear-refspecs       (foreign-lambda void git_remote_clear_refspecs remote))
(define remote-refspec-count        (foreign-lambda int git_remote_refspec_count remote))
(define remote-stats                (foreign-lambda transfer-progress git_remote_stats remote))
(define remote-free                 (foreign-lambda void git_remote_free remote))
(define remote-stop                 (foreign-lambda void git_remote_stop remote))
(define remote-disconnect           (foreign-lambda void git_remote_disconnect remote))
(define remote-check-cert           (foreign-lambda void git_remote_check_cert remote bool))
(define remote-set-update-fetchhead (foreign-lambda void git_remote_set_update_fetchhead remote bool))
(define remote-name                 (foreign-lambda c-string git_remote_name remote))
(define remote-url                  (foreign-lambda c-string git_remote_url remote))
(define remote-pushurl              (foreign-lambda c-string git_remote_pushurl remote))
(define remote-connected            (foreign-lambda bool git_remote_connected remote))
(define remote-valid-url            (foreign-lambda bool git_remote_valid_url nonnull-c-string))
(define remote-supported-url        (foreign-lambda bool git_remote_supported_url nonnull-c-string))
(define remote-is-valid-name        (foreign-lambda bool git_remote_is_valid_name nonnull-c-string))

(define-foreign-type remote-rename-problem-cb (function int ((const c-string) c-pointer)))
(define-git-callback (remote_rename_problem_cb (c-string path) (c-pointer i))
  ((handle->object i) path))

(define (remote-rename remote name)
  (let-location ((s strarray))
    ((foreign-lambda/retval git_remote_rename strarray remote nonnull-c-string) (location s) remote name)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; revwalk.h

(define-foreign-enum-type (sort int)
  (sort->int int->sort)
  ((none sort/none) GIT_SORT_NONE)
  ((topo sort/topo) GIT_SORT_TOPOLOGICAL)
  ((time sort/time) GIT_SORT_TIME)
  ((rev  sort/rev)  GIT_SORT_REVERSE))

(define revwalk-new         (foreign-lambda/allocate revwalk git_revwalk_new repository))
(define revwalk-next        (foreign-lambda/allocate oid git_revwalk_next revwalk))
(define revwalk-push        (foreign-lambda/retval git_revwalk_push revwalk oid))
(define revwalk-push-glob   (foreign-lambda/retval git_revwalk_push_glob revwalk nonnull-c-string))
(define revwalk-push-head   (foreign-lambda/retval git_revwalk_push_head revwalk))
(define revwalk-push-ref    (foreign-lambda/retval git_revwalk_push_ref revwalk nonnull-c-string))
(define revwalk-hide        (foreign-lambda/retval git_revwalk_hide revwalk oid))
(define revwalk-hide-glob   (foreign-lambda/retval git_revwalk_hide_glob revwalk nonnull-c-string))
(define revwalk-hide-head   (foreign-lambda/retval git_revwalk_hide_head revwalk))
(define revwalk-hide-ref    (foreign-lambda/retval git_revwalk_hide_ref revwalk nonnull-c-string))
(define revwalk-free        (foreign-lambda void git_revwalk_free revwalk))
(define revwalk-reset       (foreign-lambda void git_revwalk_reset revwalk))
(define revwalk-sorting     (foreign-lambda void git_revwalk_sorting revwalk sort))
(define revwalk-repository  (foreign-lambda repository git_revwalk_repository revwalk))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; revparse.h

(define-foreign-record-type (revspec git_revspec)
  (object from revspec-from)
  (object to revspec-to)
  (unsigned-int flags revspec-flags))

(define (make-revspec)
  (make-locative (make-blob (foreign-value "sizeof(git_revspec)" size_t))))

(define revparse-single (foreign-lambda/allocate object git_revparse_single repository nonnull-c-string))
(define revparse        (foreign-lambda/allocate revspec git_revparse repository nonnull-c-string))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; signature.h

(define signature-default (foreign-lambda/allocate signature git_signature_default repository))
(define signature-new     (foreign-lambda/allocate signature git_signature_new nonnull-c-string nonnull-c-string time-t int))
(define signature-now     (foreign-lambda/allocate signature git_signature_now nonnull-c-string nonnull-c-string))
(define signature-dup     (foreign-lambda/allocate signature git_signature_dup signature))
(define signature-free    (foreign-lambda void git_signature_free signature))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; status.h

(define-foreign-enum-type (status int #f)
  (status->int int->status)
  ((current           status/current)           GIT_STATUS_CURRENT)
  ((index/new         status/index/new)         GIT_STATUS_INDEX_NEW)
  ((index/modified    status/index/modified)    GIT_STATUS_INDEX_MODIFIED)
  ((index/deleted     status/index/deleted)     GIT_STATUS_INDEX_DELETED)
  ((worktree/new      status/worktree/new)      GIT_STATUS_WT_NEW)
  ((worktree/modified status/worktree/modified) GIT_STATUS_WT_MODIFIED)
  ((worktree/deleted  status/worktree/deleted)  GIT_STATUS_WT_DELETED)
  ((ignored           status/ignored)           GIT_STATUS_IGNORED))

;; Unroll compound integer status values into lists of status symbols.
(define-foreign-type status unsigned-int status->int
  (let ((int->status int->status))
    (lambda (val)
      (or (int->status val)
          (let lp ((int (foreign-value GIT_STATUS_IGNORED int))
                   (acc '()))
            (if (eq? int 0)
                acc
                (lp (fx/ int 2)
                    (if (= (bitwise-and val int) int)
                        (cons (int->status int) acc)
                        acc))))))))

(define status-file          (foreign-lambda/allocate status git_status_file repository nonnull-c-string))
(define status-should-ignore (foreign-lambda/allocate bool git_status_should_ignore repository nonnull-c-string))

(define-foreign-type status-foreach-cb (function int ((const c-string) status c-pointer)))
(define-git-callback (status_foreach_cb (c-string path) (status value) (c-pointer i))
  ((handle->object i) path value))

(define (status-foreach f repo)
  (let-handle ((callback f))
    (guard-errors git_status_foreach
     ((foreign-safe-lambda int git_status_foreach
       repository status-foreach-cb            c-pointer)
       repo       (location status_foreach_cb) callback))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; tag.h

(define tag-list       (foreign-lambda/allocate strarray git_tag_list repository))
(define tag-create     (foreign-lambda/allocate oid git_tag_create repository c-string object signature c-string bool))
(define tag-lookup     (foreign-lambda/allocate tag git_tag_lookup repository oid))
(define tag-target     (foreign-lambda/allocate object git_tag_target tag))
(define tag-peel       (foreign-lambda/allocate object git_tag_peel tag))
(define tag-delete     (foreign-lambda/retval git_tag_delete repository nonnull-c-string))
(define tag-free       (foreign-lambda void git_tag_free tag))
(define tag-id         (foreign-lambda oid git_tag_id tag))
(define tag-name       (foreign-lambda c-string git_tag_name tag))
(define tag-tagger     (foreign-lambda signature git_tag_tagger tag))
(define tag-message    (foreign-lambda c-string git_tag_message tag))

(define-foreign-type tag-foreach-cb (function int ((const c-string) oid c-pointer)))
(define-git-callback (tag_foreach_cb (c-string name) (oid oid) (c-pointer i))
  ((handle->object i) name oid))

(define (tag-foreach f repo)
  (let-handle ((callback f))
    (guard-errors git_tag_foreach
     ((foreign-safe-lambda int git_tag_foreach
       repository tag-foreach-cb            c-pointer)
       repo       (location tag_foreach_cb) callback))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; tree.h

(define-foreign-enum-type (treewalk-mode int)
  (treewalk-mode->int int->treewalk-mode)
  ((pre  treewalk-mode/pre)  GIT_TREEWALK_PRE)
  ((post treewalk-mode/post) GIT_TREEWALK_POST))

(define tree-lookup           (foreign-lambda/allocate tree git_tree_lookup repository oid))
(define tree-lookup-prefix    (foreign-lambda/allocate tree git_tree_lookup_prefix repository oid unsigned-int))
(define tree-entry-to-object  (foreign-lambda/allocate object git_tree_entry_to_object repository tree-entry))
(define tree-entry-bypath     (foreign-lambda/allocate tree-entry git_tree_entry_bypath tree nonnull-c-string))
(define tree-builder-create   (foreign-lambda/allocate tree-builder git_treebuilder_create tree))
(define tree-builder-insert   (foreign-lambda/allocate (const tree-entry) git_treebuilder_insert tree-builder c-string oid unsigned-int))
(define tree-builder-write    (foreign-lambda/allocate oid git_treebuilder_write repository tree-builder))
(define tree-entry-dup        (foreign-lambda/allocate tree-entry git_tree_entry_dup tree-entry))
(define tree-builder-remove   (foreign-lambda/retval git_treebuilder_remove tree-builder nonnull-c-string))
(define tree-free             (foreign-lambda void git_tree_free tree))
(define tree-id               (foreign-lambda oid git_tree_id tree))
(define tree-entrycount       (foreign-lambda unsigned-int git_tree_entrycount tree))
(define tree-entry-byname     (foreign-lambda tree-entry git_tree_entry_byname tree nonnull-c-string))
(define tree-entry-byindex    (foreign-lambda tree-entry git_tree_entry_byindex tree size_t))
(define tree-entry-byoid      (foreign-lambda tree-entry git_tree_entry_byid tree oid))
(define tree-entry-name       (foreign-lambda c-string git_tree_entry_name tree-entry))
(define tree-entry-id         (foreign-lambda oid git_tree_entry_id tree-entry))
(define tree-entry-type       (foreign-lambda object-type git_tree_entry_type tree-entry))
(define tree-entry-filemode   (foreign-lambda filemode git_tree_entry_filemode tree-entry))
(define tree-entry-free       (foreign-lambda void git_tree_entry_free tree-entry))
(define tree-builder-free     (foreign-lambda void git_treebuilder_free tree-builder))
(define tree-builder-clear    (foreign-lambda void git_treebuilder_clear tree-builder))
(define tree-builder-get      (foreign-lambda tree-entry git_treebuilder_get tree-builder nonnull-c-string))

;; (define-foreign-type treewalk-cb (c-pointer "git_treewalk_cb"))
(define-foreign-type treewalk-cb (function int ((const c-string) (const tree-entry) c-pointer)))
(define-git-callback (treewalk_cb (c-string root) (tree-entry entry) (c-pointer i))
  ((handle->object i) root entry))

(define (tree-walk tree f mode)
  (let-handle ((callback f))
    (guard-errors git_tree_walk
     ((foreign-safe-lambda int git_tree_walk
       (const tree) treewalk-mode treewalk-cb            c-pointer)
       tree         mode          (location treewalk_cb) callback)))))