{-# LINE 1 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 2 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 3 "Bindings/Libgit2/OdbBackend.hsc" #-}
module Bindings.Libgit2.OdbBackend where
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 5 "Bindings/Libgit2/OdbBackend.hsc" #-}

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 *);
}; -}
type C'git_odb_backend_read_callback = FunPtr (Ptr (Ptr ()) -> Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt)
foreign import ccall "wrapper" mk'git_odb_backend_read_callback
  :: (Ptr (Ptr ()) -> Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt) -> IO C'git_odb_backend_read_callback
foreign import ccall "dynamic" mK'git_odb_backend_read_callback
  :: C'git_odb_backend_read_callback -> (Ptr (Ptr ()) -> Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt)

{-# LINE 43 "Bindings/Libgit2/OdbBackend.hsc" #-}
type C'git_odb_backend_read_prefix_callback = FunPtr (Ptr C'git_oid -> Ptr (Ptr ()) -> Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid -> CUInt -> IO CInt)
foreign import ccall "wrapper" mk'git_odb_backend_read_prefix_callback
  :: (Ptr C'git_oid -> Ptr (Ptr ()) -> Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid -> CUInt -> IO CInt) -> IO C'git_odb_backend_read_prefix_callback
foreign import ccall "dynamic" mK'git_odb_backend_read_prefix_callback
  :: C'git_odb_backend_read_prefix_callback -> (Ptr C'git_oid -> Ptr (Ptr ()) -> Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid -> CUInt -> IO CInt)

{-# LINE 44 "Bindings/Libgit2/OdbBackend.hsc" #-}
type C'git_odb_backend_read_header_callback = FunPtr (Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt)
foreign import ccall "wrapper" mk'git_odb_backend_read_header_callback
  :: (Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt) -> IO C'git_odb_backend_read_header_callback
foreign import ccall "dynamic" mK'git_odb_backend_read_header_callback
  :: C'git_odb_backend_read_header_callback -> (Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt)

{-# LINE 45 "Bindings/Libgit2/OdbBackend.hsc" #-}
type C'git_odb_backend_write_callback = FunPtr (Ptr C'git_oid -> Ptr C'git_odb_backend -> Ptr () -> CSize -> C'git_otype -> IO CInt)
foreign import ccall "wrapper" mk'git_odb_backend_write_callback
  :: (Ptr C'git_oid -> Ptr C'git_odb_backend -> Ptr () -> CSize -> C'git_otype -> IO CInt) -> IO C'git_odb_backend_write_callback
foreign import ccall "dynamic" mK'git_odb_backend_write_callback
  :: C'git_odb_backend_write_callback -> (Ptr C'git_oid -> Ptr C'git_odb_backend -> Ptr () -> CSize -> C'git_otype -> IO CInt)

{-# LINE 46 "Bindings/Libgit2/OdbBackend.hsc" #-}
type C'git_odb_backend_writestream_callback = FunPtr (Ptr (Ptr C'git_odb_stream) -> Ptr C'git_odb_backend -> CSize -> C'git_otype -> IO CInt)
foreign import ccall "wrapper" mk'git_odb_backend_writestream_callback
  :: (Ptr (Ptr C'git_odb_stream) -> Ptr C'git_odb_backend -> CSize -> C'git_otype -> IO CInt) -> IO C'git_odb_backend_writestream_callback
foreign import ccall "dynamic" mK'git_odb_backend_writestream_callback
  :: C'git_odb_backend_writestream_callback -> (Ptr (Ptr C'git_odb_stream) -> Ptr C'git_odb_backend -> CSize -> C'git_otype -> IO CInt)

{-# LINE 47 "Bindings/Libgit2/OdbBackend.hsc" #-}
type C'git_odb_backend_readstream_callback = FunPtr (Ptr (Ptr C'git_odb_stream) -> Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt)
foreign import ccall "wrapper" mk'git_odb_backend_readstream_callback
  :: (Ptr (Ptr C'git_odb_stream) -> Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt) -> IO C'git_odb_backend_readstream_callback
foreign import ccall "dynamic" mK'git_odb_backend_readstream_callback
  :: C'git_odb_backend_readstream_callback -> (Ptr (Ptr C'git_odb_stream) -> Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt)

{-# LINE 48 "Bindings/Libgit2/OdbBackend.hsc" #-}
type C'git_odb_backend_exists_callback = FunPtr (Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt)
foreign import ccall "wrapper" mk'git_odb_backend_exists_callback
  :: (Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt) -> IO C'git_odb_backend_exists_callback
foreign import ccall "dynamic" mK'git_odb_backend_exists_callback
  :: C'git_odb_backend_exists_callback -> (Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt)

{-# LINE 49 "Bindings/Libgit2/OdbBackend.hsc" #-}
type C'git_odb_backend_free_callback = FunPtr (Ptr C'git_odb_backend -> IO ())
foreign import ccall "wrapper" mk'git_odb_backend_free_callback
  :: (Ptr C'git_odb_backend -> IO ()) -> IO C'git_odb_backend_free_callback
foreign import ccall "dynamic" mK'git_odb_backend_free_callback
  :: C'git_odb_backend_free_callback -> (Ptr C'git_odb_backend -> IO ())

{-# LINE 50 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 51 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 52 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 53 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 54 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 55 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 56 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 57 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 58 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 59 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 60 "Bindings/Libgit2/OdbBackend.hsc" #-}
data C'git_odb_backend = C'git_odb_backend{
  c'git_odb_backend'odb :: Ptr C'git_odb,
  c'git_odb_backend'read :: C'git_odb_backend_read_callback,
  c'git_odb_backend'read_prefix :: C'git_odb_backend_read_prefix_callback,
  c'git_odb_backend'read_header :: C'git_odb_backend_read_header_callback,
  c'git_odb_backend'write :: C'git_odb_backend_write_callback,
  c'git_odb_backend'writestream :: C'git_odb_backend_writestream_callback,
  c'git_odb_backend'readstream :: C'git_odb_backend_readstream_callback,
  c'git_odb_backend'exists :: C'git_odb_backend_exists_callback,
  c'git_odb_backend'free :: C'git_odb_backend_free_callback
} deriving (Eq,Show)
p'git_odb_backend'odb p = plusPtr p 0
p'git_odb_backend'odb :: Ptr (C'git_odb_backend) -> Ptr (Ptr C'git_odb)
p'git_odb_backend'read p = plusPtr p 4
p'git_odb_backend'read :: Ptr (C'git_odb_backend) -> Ptr (C'git_odb_backend_read_callback)
p'git_odb_backend'read_prefix p = plusPtr p 8
p'git_odb_backend'read_prefix :: Ptr (C'git_odb_backend) -> Ptr (C'git_odb_backend_read_prefix_callback)
p'git_odb_backend'read_header p = plusPtr p 12
p'git_odb_backend'read_header :: Ptr (C'git_odb_backend) -> Ptr (C'git_odb_backend_read_header_callback)
p'git_odb_backend'write p = plusPtr p 16
p'git_odb_backend'write :: Ptr (C'git_odb_backend) -> Ptr (C'git_odb_backend_write_callback)
p'git_odb_backend'writestream p = plusPtr p 20
p'git_odb_backend'writestream :: Ptr (C'git_odb_backend) -> Ptr (C'git_odb_backend_writestream_callback)
p'git_odb_backend'readstream p = plusPtr p 24
p'git_odb_backend'readstream :: Ptr (C'git_odb_backend) -> Ptr (C'git_odb_backend_readstream_callback)
p'git_odb_backend'exists p = plusPtr p 28
p'git_odb_backend'exists :: Ptr (C'git_odb_backend) -> Ptr (C'git_odb_backend_exists_callback)
p'git_odb_backend'free p = plusPtr p 32
p'git_odb_backend'free :: Ptr (C'git_odb_backend) -> Ptr (C'git_odb_backend_free_callback)
instance Storable C'git_odb_backend where
  sizeOf _ = 36
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    v3 <- peekByteOff p 12
    v4 <- peekByteOff p 16
    v5 <- peekByteOff p 20
    v6 <- peekByteOff p 24
    v7 <- peekByteOff p 28
    v8 <- peekByteOff p 32
    return $ C'git_odb_backend v0 v1 v2 v3 v4 v5 v6 v7 v8
  poke p (C'git_odb_backend v0 v1 v2 v3 v4 v5 v6 v7 v8) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    pokeByteOff p 12 v3
    pokeByteOff p 16 v4
    pokeByteOff p 20 v5
    pokeByteOff p 24 v6
    pokeByteOff p 28 v7
    pokeByteOff p 32 v8
    return ()

{-# LINE 61 "Bindings/Libgit2/OdbBackend.hsc" #-}
{- enum {
    GIT_STREAM_RDONLY = 1 << 1,
    GIT_STREAM_WRONLY = 1 << 2,
    GIT_STREAM_RW = GIT_STREAM_RDONLY | GIT_STREAM_WRONLY
}; -}
c'GIT_STREAM_RDONLY = 2
c'GIT_STREAM_RDONLY :: (Num a) => a

{-# LINE 67 "Bindings/Libgit2/OdbBackend.hsc" #-}
c'GIT_STREAM_WRONLY = 4
c'GIT_STREAM_WRONLY :: (Num a) => a

{-# LINE 68 "Bindings/Libgit2/OdbBackend.hsc" #-}
c'GIT_STREAM_RW = 6
c'GIT_STREAM_RW :: (Num a) => a

{-# LINE 69 "Bindings/Libgit2/OdbBackend.hsc" #-}
{- 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);
}; -}
type C'git_odb_stream_read_callback = FunPtr (Ptr C'git_odb_stream -> CString -> CSize -> IO CInt)
foreign import ccall "wrapper" mk'git_odb_stream_read_callback
  :: (Ptr C'git_odb_stream -> CString -> CSize -> IO CInt) -> IO C'git_odb_stream_read_callback
foreign import ccall "dynamic" mK'git_odb_stream_read_callback
  :: C'git_odb_stream_read_callback -> (Ptr C'git_odb_stream -> CString -> CSize -> IO CInt)

{-# LINE 83 "Bindings/Libgit2/OdbBackend.hsc" #-}
type C'git_odb_stream_write_callback = FunPtr (Ptr C'git_odb_stream -> CString -> CSize -> IO CInt)
foreign import ccall "wrapper" mk'git_odb_stream_write_callback
  :: (Ptr C'git_odb_stream -> CString -> CSize -> IO CInt) -> IO C'git_odb_stream_write_callback
foreign import ccall "dynamic" mK'git_odb_stream_write_callback
  :: C'git_odb_stream_write_callback -> (Ptr C'git_odb_stream -> CString -> CSize -> IO CInt)

{-# LINE 84 "Bindings/Libgit2/OdbBackend.hsc" #-}
type C'git_odb_stream_finalize_write_callback = FunPtr (Ptr C'git_oid -> Ptr C'git_odb_stream -> IO CInt)
foreign import ccall "wrapper" mk'git_odb_stream_finalize_write_callback
  :: (Ptr C'git_oid -> Ptr C'git_odb_stream -> IO CInt) -> IO C'git_odb_stream_finalize_write_callback
foreign import ccall "dynamic" mK'git_odb_stream_finalize_write_callback
  :: C'git_odb_stream_finalize_write_callback -> (Ptr C'git_oid -> Ptr C'git_odb_stream -> IO CInt)

{-# LINE 85 "Bindings/Libgit2/OdbBackend.hsc" #-}
type C'git_odb_stream_free_callback = FunPtr (Ptr C'git_odb_stream -> IO ())
foreign import ccall "wrapper" mk'git_odb_stream_free_callback
  :: (Ptr C'git_odb_stream -> IO ()) -> IO C'git_odb_stream_free_callback
foreign import ccall "dynamic" mK'git_odb_stream_free_callback
  :: C'git_odb_stream_free_callback -> (Ptr C'git_odb_stream -> IO ())

{-# LINE 86 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 87 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 88 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 89 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 90 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 91 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 92 "Bindings/Libgit2/OdbBackend.hsc" #-}

{-# LINE 93 "Bindings/Libgit2/OdbBackend.hsc" #-}
data C'git_odb_stream = C'git_odb_stream{
  c'git_odb_stream'backend :: Ptr C'git_odb_backend,
  c'git_odb_stream'mode :: CInt,
  c'git_odb_stream'read :: C'git_odb_stream_read_callback,
  c'git_odb_stream'write :: C'git_odb_stream_write_callback,
  c'git_odb_stream'finalize_write :: C'git_odb_stream_finalize_write_callback,
  c'git_odb_stream'free :: C'git_odb_stream_free_callback
} deriving (Eq,Show)
p'git_odb_stream'backend p = plusPtr p 0
p'git_odb_stream'backend :: Ptr (C'git_odb_stream) -> Ptr (Ptr C'git_odb_backend)
p'git_odb_stream'mode p = plusPtr p 4
p'git_odb_stream'mode :: Ptr (C'git_odb_stream) -> Ptr (CInt)
p'git_odb_stream'read p = plusPtr p 8
p'git_odb_stream'read :: Ptr (C'git_odb_stream) -> Ptr (C'git_odb_stream_read_callback)
p'git_odb_stream'write p = plusPtr p 12
p'git_odb_stream'write :: Ptr (C'git_odb_stream) -> Ptr (C'git_odb_stream_write_callback)
p'git_odb_stream'finalize_write p = plusPtr p 16
p'git_odb_stream'finalize_write :: Ptr (C'git_odb_stream) -> Ptr (C'git_odb_stream_finalize_write_callback)
p'git_odb_stream'free p = plusPtr p 20
p'git_odb_stream'free :: Ptr (C'git_odb_stream) -> Ptr (C'git_odb_stream_free_callback)
instance Storable C'git_odb_stream where
  sizeOf _ = 24
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    v3 <- peekByteOff p 12
    v4 <- peekByteOff p 16
    v5 <- peekByteOff p 20
    return $ C'git_odb_stream v0 v1 v2 v3 v4 v5
  poke p (C'git_odb_stream v0 v1 v2 v3 v4 v5) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    pokeByteOff p 12 v3
    pokeByteOff p 16 v4
    pokeByteOff p 20 v5
    return ()

{-# LINE 94 "Bindings/Libgit2/OdbBackend.hsc" #-}
foreign import ccall "git_odb_backend_pack" c'git_odb_backend_pack
  :: Ptr (Ptr C'git_odb_backend) -> CString -> IO (CInt)
foreign import ccall "&git_odb_backend_pack" p'git_odb_backend_pack
  :: FunPtr (Ptr (Ptr C'git_odb_backend) -> CString -> IO (CInt))

{-# LINE 95 "Bindings/Libgit2/OdbBackend.hsc" #-}
foreign import ccall "git_odb_backend_loose" c'git_odb_backend_loose
  :: Ptr (Ptr C'git_odb_backend) -> CString -> CInt -> CInt -> IO (CInt)
foreign import ccall "&git_odb_backend_loose" p'git_odb_backend_loose
  :: FunPtr (Ptr (Ptr C'git_odb_backend) -> CString -> CInt -> CInt -> IO (CInt))

{-# LINE 96 "Bindings/Libgit2/OdbBackend.hsc" #-}