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

(module git-lolevel *
  (import scheme lolevel foreign foreigners srfi-69
    (except chicken repository-path)
    (only srfi-13 string-index))
  (require-library srfi-13 lolevel)

;; 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*
            ((oid)
             `(let ((oid (make-oid)))
                ((foreign-lambda/retval ,name ,type ,@args) oid ,@formals)
                (set-finalizer! oid oid-free)))
            ((strarray)
             `(let ((sa (make-strarray)))
                ((foreign-lambda/retval ,name ,type ,@args) sa ,@formals)
                (strarray-retrieve sa)))
            (else
             `(let-location ((object ,type*))
                ((foreign-lambda/retval ,name (c-pointer ,type) ,@args) (location object) ,@formals)
                object)))))))

;;;
;;; 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 pointer keys to the libgit2 functions that need them.
;;;

(define-values (callback-lookup callback-unregister! callback-register!)
  (let ((callback-index 1)
        (callback-table (make-hash-table)))
    (values
     (lambda (i) (hash-table-ref callback-table (pointer->address i)))
     (lambda (i) (hash-table-delete! callback-table (pointer->address i)))
     (lambda (c)
       (let ((index callback-index))
         (hash-table-set! callback-table index c)
         (set! callback-index (+ index 1))
         (address->pointer index))))))

(define (call-with-callback c proc)
  (let ((callback #f))
    (dynamic-wind
     (lambda () (set! callback (callback-register! c)))
     (lambda () (proc callback))
     (lambda () (callback-unregister! callback)))))

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

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

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

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

(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)
  (constructor: make-oid)
  (destructor: oid-free)
  (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) oid index-entry-oid)
  (unsigned-int flags index-entry-flags)
  (unsigned-int flags_extended index-entry-extended)
  (c-string path index-entry-path))

(define-foreign-record-type (index-reuc-entry git_index_reuc_entry)
  (unsigned-int (mode 3) index-reuc-entry-mode)
  ((struct oid) (oid 3) index-reuc-entry-oid)
  (c-string path index-reuc-entry-path))

(define-foreign-enum-type (object-type int)
  (object-type->int int->object-type)
  ((any       object-type/any)       GIT_OBJ_ANY)
  ((bad       object-type/bad)       GIT_OBJ_BAD)
  ((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))

(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 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 push             (c-pointer "git_push"))
(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"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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*-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*))

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

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

(define branch-list   (foreign-lambda/allocate strarray git_branch_list repository))
(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 int))
(define branch-move   (foreign-lambda/allocate reference git_branch_move reference nonnull-c-string bool))
(define branch-delete (foreign-lambda/retval git_branch_delete reference))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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-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-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-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 ptrs)
  ((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);")
    ptrs
    (length ptrs)))

(define (commit-create repo ref author commit msg tree parents)
  (let ((parents* #f))
    (dynamic-wind
     (lambda ()
       (set! parents* (pack-commit-pointer-array parents)))
     (lambda ()
       ((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 (length parents) parents*))
     (lambda ()
       (free parents*)))))

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

(define-foreign-record-type (strarray git_strarray)
  (constructor: make-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-strings
  (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;
     C_return(t);"))

(define strarray-free
  (foreign-lambda void git_strarray_free strarray))

(define (strarray-retrieve sa)
  (let ((lst (strarray-strings sa)))
    (strarray-free sa)
    lst))

(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)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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-syntax foreign-lambda/config-path
  (lambda (e . _)
    `(lambda ()
       (let* ((len (foreign-value GIT_PATH_MAX int))
              (str (make-string len)))
         ((foreign-lambda/retval ,(cadr e) scheme-pointer unsigned-int) str len)
         (substring str 0 (string-index str #\x00))))))

(define config-find-global (foreign-lambda/config-path git_config_find_global))
(define config-find-system (foreign-lambda/config-path git_config_find_system))
(define config-find-xdg    (foreign-lambda/config-path 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-list (c-pointer "git_diff_list"))
(define-foreign-type diff-file-fn (c-pointer "git_diff_file_fn"))

(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)   oid    diff-file-oid)
  (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)
  ((struct diff-file) old_file   diff-delta-old-file)
  ((struct diff-file) new_file   diff-delta-new-file)
  (delta              status     diff-delta-status)
  (unsigned-int32     similarity diff-delta-similarity)
  (unsigned-int32     flags      diff-delta-flags))

(define-foreign-record-type (diff-range git_diff_range)
  (int old_start diff-range-old-start)
  (int old_lines diff-range-old-lines)
  (int new_start diff-range-new-start)
  (int new_lines diff-range-new-lines))

(define diff-list-free (foreign-lambda void git_diff_list_free diff-list))
(define diff-merge     (foreign-lambda/retval git_diff_merge diff-list diff-list))

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

(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 (c-pointer "git_diff_file_cb"))
(define-foreign-type diff-file-cb (function int ((const diff-delta) float c-pointer)))
(define-external (diff_file_cb (diff-delta diff) (float progress) (c-pointer fn)) int
  ((callback-lookup fn) diff progress) 0)

;; (define-foreign-type diff-hunk-cb (c-pointer "git_diff_hunk_cb"))
(define-foreign-type diff-hunk-cb (function int ((const diff-delta) (const diff-range) (const c-string) size_t c-pointer)))
(define-external (diff_hunk_cb (diff-delta diff) (diff-range range) (float progress) (c-pointer fn)) int
  ((callback-lookup fn) diff range) 0)

;; (define-foreign-type diff-data-cb (c-pointer "git_diff_data_cb"))
(define-foreign-type diff-data-cb (function int ((const diff-delta) (const diff-range) char (const c-string) size_t c-pointer)))
(define-external (diff_data_cb (diff-delta diff) (diff-range range) (char line) (c-string content) (size_t len) (c-pointer fn)) int
  ((callback-lookup fn) diff range line content) 0)

(define (diff-foreach fn diffs)
  (call-with-callback fn
   (lambda (callback)
     (guard-errors git_diff_foreach
      ((foreign-safe-lambda int git_diff_foreach
        diff-list diff-file-cb            diff-hunk-cb diff-data-cb c-pointer)
        diffs     (location diff_file_cb) #f           #f           callback)))))

(define (diff-blobs old new fn diffs)
  (call-with-callback fn
   (lambda (callback)
     (guard-errors git_diff_blobs
      ((foreign-safe-lambda int git_diff_blobs
        blob* blob* diff-options diff-file-cb            c-pointer c-pointer c-pointer)
        old   new   #f           (location diff_file_cb) #f        #f        callback)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))
(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-external (transfer_progress_cb (transfer-progress stats) (c-pointer fn)) int
  ((callback-lookup fn) stats) 0)

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

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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-cpy          (foreign-lambda void git_oid_cpy oid oid))
(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 (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)))

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

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

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

(define reference-list                (foreign-lambda/allocate strarray git_reference_list repository ref-type))
(define reference-lookup              (foreign-lambda/allocate reference git_reference_lookup repository nonnull-c-string))
(define reference-symbolic-create     (foreign-lambda/allocate reference git_reference_symbolic_create repository nonnull-c-string nonnull-c-string bool))
(define reference-create              (foreign-lambda/allocate reference git_reference_create repository nonnull-c-string oid bool))
(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))
(define reference-set-target          (foreign-lambda/allocate reference git_reference_set_target reference oid))
(define reference-symbolic-set-target (foreign-lambda/allocate reference git_reference_symbolic_set_target reference nonnull-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 ref-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-foreign-type reference-foreach-cb (function int ((const c-string) c-pointer)))
(define-external (reference_foreach_cb (c-string name) (c-pointer fn)) int
  ((callback-lookup fn) name) 0)

(define (reference-foreach repo flags fn)
  (call-with-callback fn
   (lambda (callback)
     (guard-errors git_reference_foreach
      ((foreign-safe-lambda int git_reference_foreach
        repository ref-type reference-foreach-cb            c-pointer)
        repo       flags    (location reference_foreach_cb) callback)))))

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

(define refspec-src         (foreign-lambda c-string git_refspec_src refspec))
(define refspec-dst         (foreign-lambda c-string git_refspec_dst 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-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-orphan   (foreign-lambda bool git_repository_head_orphan repository))

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

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

(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-list                 (foreign-lambda/allocate strarray git_remote_list repository))
(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-connect              (foreign-lambda/retval git_remote_connect remote direction))
(define remote-save                 (foreign-lambda/retval git_remote_save remote))
(define remote-set-fetchspec        (foreign-lambda/retval git_remote_set_fetchspec remote nonnull-c-string))
(define remote-set-pushspec         (foreign-lambda/retval git_remote_set_pushspec remote nonnull-c-string))
(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))
(define remote-update-fetchhead     (foreign-lambda/retval git_remote_update_fetchhead 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-fetchspec            (foreign-lambda refspec git_remote_fetchspec remote))
(define remote-pushspec             (foreign-lambda refspec git_remote_pushspec 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-download remote fn)
  (if (not fn)
      ((foreign-lambda/retval git_remote_download remote transfer-progress-cb c-pointer) remote #f #f)
      (call-with-callback fn
       (lambda (cb)
         (guard-errors git_remote_download
          ((foreign-safe-lambda int git_remote_download
            remote transfer-progress-cb            c-pointer)
            remote (location transfer_progress_cb) cb))))))

(define-foreign-type remote-rename-problem-cb (function int ((const c-string) c-pointer)))
(define-external (remote_rename_problem_cb (c-string path) (c-pointer fn)) int
  ((callback-lookup fn) path) 0)

(define (remote-rename remote name fn)
  (if (not fn)
      ((foreign-lambda/retval git_remote_rename remote nonnull-c-string remote-rename-problem-cb c-pointer) remote name #f #f)
      (call-with-callback fn
       (lambda (cb)
         ((foreign-safe-lambda int git_remote_rename
           remote nonnull-c-string remote-rename-problem-cb            c-pointer)
           remote name             (location remote_rename_problem_cb) cb)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))

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

(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 signature git_signature_dup signature))
(define signature-free (foreign-lambda void git_signature_free signature))

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

(define-foreign-enum-type (status unsigned-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-external (status_foreach_cb (c-string path) (status value) (c-pointer fn)) int
  ((callback-lookup fn) path value) 0)

(define (status-foreach fn repo)
  (call-with-callback fn
   (lambda (callback)
     (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-external (tag_foreach_cb (c-string name) (oid oid) (c-pointer fn)) int
  ((callback-lookup fn) name oid) 0)

(define (tag-foreach fn repo)
  (call-with-callback fn
   (lambda (callback)
     (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-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_byoid 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-dup        (foreign-lambda tree-entry git_tree_entry_dup 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-external (treewalk_cb (c-string root) (tree-entry entry) (c-pointer fn)) int
  ((callback-lookup fn) root entry) 0)

(define (tree-walk tree fn mode)
  (call-with-callback fn
   (lambda (callback)
     (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))))))