#include #include module Bindings.Libgit2.OdbBackend where #strict_import import Bindings.Libgit2.Common import Bindings.Libgit2.Types import Bindings.Libgit2.Oid {- struct git_odb_backend { git_odb * odb; int (* read)(void * *, size_t *, git_otype *, struct git_odb_backend *, const git_oid *); int (* read_prefix)(git_oid *, void * *, size_t *, git_otype *, struct git_odb_backend *, const git_oid *, unsigned int); int (* read_header)(size_t *, git_otype *, struct git_odb_backend *, const git_oid *); int (* write)(git_oid *, struct git_odb_backend *, const void *, size_t, git_otype); int (* writestream)(struct git_odb_stream * *, struct git_odb_backend *, size_t, git_otype); int (* readstream)(struct git_odb_stream * *, struct git_odb_backend *, const git_oid *); int (* exists)(struct git_odb_backend *, const git_oid *); void (* free)(struct git_odb_backend *); }; -} #starttype git_odb_backend #field odb , Ptr #field read , FunPtr (Ptr (Ptr ()) -> Ptr CSize -> Ptr -> Ptr -> Ptr -> CInt) #field read_prefix , FunPtr (Ptr -> Ptr (Ptr ()) -> Ptr CSize -> Ptr -> Ptr -> Ptr -> CUInt -> CInt) #field read_header , FunPtr (Ptr CSize -> Ptr -> Ptr -> Ptr -> CInt) #field write , FunPtr (Ptr -> Ptr -> Ptr () -> CSize -> -> CInt) #field writestream , FunPtr (Ptr (Ptr ) -> Ptr -> CSize -> -> CInt) #field readstream , FunPtr (Ptr (Ptr ) -> Ptr -> Ptr -> CInt) #field exists , FunPtr (Ptr -> Ptr -> CInt) #field free , FunPtr (Ptr ) #stoptype {- enum { GIT_STREAM_RDONLY = 1 << 1, GIT_STREAM_WRONLY = 1 << 2, GIT_STREAM_RW = GIT_STREAM_RDONLY | GIT_STREAM_WRONLY }; -} #num GIT_STREAM_RDONLY #num GIT_STREAM_WRONLY #num GIT_STREAM_RW {- struct git_odb_stream { struct git_odb_backend * backend; int mode; int (* read)(struct git_odb_stream * stream, char * buffer, size_t len); int (* write)(struct git_odb_stream * stream, const char * buffer, size_t len); int (* finalize_write)(git_oid * oid_p, struct git_odb_stream * stream); void (* free)(struct git_odb_stream * stream); }; -} #starttype git_odb_stream #field backend , Ptr #field mode , CInt #field read , FunPtr (Ptr -> CString -> CSize -> CInt) #field write , FunPtr (Ptr -> CString -> CSize -> CInt) #field finalize_write , FunPtr (Ptr -> Ptr -> CInt) #field free , FunPtr (Ptr ) #stoptype #ccall git_odb_backend_pack , Ptr (Ptr ) -> CString -> IO (CInt) #ccall git_odb_backend_loose , Ptr (Ptr ) -> CString -> CInt -> CInt -> IO (CInt)