module Bindings.Libgit2.Status where
import Foreign.Ptr
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
import Bindings.Libgit2.Common
import Bindings.Libgit2.Types
import Bindings.Libgit2.Strarray
type C'git_status_t = CUInt
c'GIT_STATUS_CURRENT = 0
c'GIT_STATUS_CURRENT :: (Num a) => a
c'GIT_STATUS_INDEX_NEW = 1
c'GIT_STATUS_INDEX_NEW :: (Num a) => a
c'GIT_STATUS_INDEX_MODIFIED = 2
c'GIT_STATUS_INDEX_MODIFIED :: (Num a) => a
c'GIT_STATUS_INDEX_DELETED = 4
c'GIT_STATUS_INDEX_DELETED :: (Num a) => a
c'GIT_STATUS_INDEX_RENAMED = 8
c'GIT_STATUS_INDEX_RENAMED :: (Num a) => a
c'GIT_STATUS_INDEX_TYPECHANGE = 16
c'GIT_STATUS_INDEX_TYPECHANGE :: (Num a) => a
c'GIT_STATUS_WT_NEW = 128
c'GIT_STATUS_WT_NEW :: (Num a) => a
c'GIT_STATUS_WT_MODIFIED = 256
c'GIT_STATUS_WT_MODIFIED :: (Num a) => a
c'GIT_STATUS_WT_DELETED = 512
c'GIT_STATUS_WT_DELETED :: (Num a) => a
c'GIT_STATUS_WT_TYPECHANGE = 1024
c'GIT_STATUS_WT_TYPECHANGE :: (Num a) => a
c'GIT_STATUS_IGNORED = 16384
c'GIT_STATUS_IGNORED :: (Num a) => a
type C'git_status_cb = FunPtr (CString -> CUInt -> Ptr () -> IO CInt)
foreign import ccall "wrapper" mk'git_status_cb
:: (CString -> CUInt -> Ptr () -> IO CInt) -> IO C'git_status_cb
foreign import ccall "dynamic" mK'git_status_cb
:: C'git_status_cb -> (CString -> CUInt -> Ptr () -> IO CInt)
foreign import ccall "git_status_foreach" c'git_status_foreach
:: Ptr C'git_repository -> C'git_status_cb -> Ptr () -> IO (CInt)
foreign import ccall "&git_status_foreach" p'git_status_foreach
:: FunPtr (Ptr C'git_repository -> C'git_status_cb -> Ptr () -> IO (CInt))
type C'git_status_show_t = CUInt
c'GIT_STATUS_SHOW_INDEX_AND_WORKDIR = 0
c'GIT_STATUS_SHOW_INDEX_AND_WORKDIR :: (Num a) => a
c'GIT_STATUS_SHOW_INDEX_ONLY = 1
c'GIT_STATUS_SHOW_INDEX_ONLY :: (Num a) => a
c'GIT_STATUS_SHOW_WORKDIR_ONLY = 2
c'GIT_STATUS_SHOW_WORKDIR_ONLY :: (Num a) => a
c'GIT_STATUS_SHOW_INDEX_THEN_WORKDIR = 3
c'GIT_STATUS_SHOW_INDEX_THEN_WORKDIR :: (Num a) => a
type C'git_status_opt_t = CUInt
c'GIT_STATUS_OPT_INCLUDE_UNTRACKED = 1
c'GIT_STATUS_OPT_INCLUDE_UNTRACKED :: (Num a) => a
c'GIT_STATUS_OPT_INCLUDE_IGNORED = 2
c'GIT_STATUS_OPT_INCLUDE_IGNORED :: (Num a) => a
c'GIT_STATUS_OPT_INCLUDE_UNMODIFIED = 4
c'GIT_STATUS_OPT_INCLUDE_UNMODIFIED :: (Num a) => a
c'GIT_STATUS_OPT_EXCLUDE_SUBMODULES = 8
c'GIT_STATUS_OPT_EXCLUDE_SUBMODULES :: (Num a) => a
c'GIT_STATUS_OPT_RECURSE_UNTRACKED_DIRS = 16
c'GIT_STATUS_OPT_RECURSE_UNTRACKED_DIRS :: (Num a) => a
c'GIT_STATUS_OPT_DISABLE_PATHSPEC_MATCH = 32
c'GIT_STATUS_OPT_DISABLE_PATHSPEC_MATCH :: (Num a) => a
c'GIT_STATUS_OPT_RECURSE_IGNORED_DIRS = 64
c'GIT_STATUS_OPT_RECURSE_IGNORED_DIRS :: (Num a) => a
data C'git_status_options = C'git_status_options{
c'git_status_options'version :: CUInt,
c'git_status_options'show :: C'git_status_show_t,
c'git_status_options'flags :: CUInt,
c'git_status_options'pathspec :: C'git_strarray
} deriving (Eq,Show)
p'git_status_options'version p = plusPtr p 0
p'git_status_options'version :: Ptr (C'git_status_options) -> Ptr (CUInt)
p'git_status_options'show p = plusPtr p 4
p'git_status_options'show :: Ptr (C'git_status_options) -> Ptr (C'git_status_show_t)
p'git_status_options'flags p = plusPtr p 8
p'git_status_options'flags :: Ptr (C'git_status_options) -> Ptr (CUInt)
p'git_status_options'pathspec p = plusPtr p 16
p'git_status_options'pathspec :: Ptr (C'git_status_options) -> Ptr (C'git_strarray)
instance Storable C'git_status_options where
sizeOf _ = 32
alignment _ = 8
peek p = do
v0 <- peekByteOff p 0
v1 <- peekByteOff p 4
v2 <- peekByteOff p 8
v3 <- peekByteOff p 16
return $ C'git_status_options v0 v1 v2 v3
poke p (C'git_status_options v0 v1 v2 v3) = do
pokeByteOff p 0 v0
pokeByteOff p 4 v1
pokeByteOff p 8 v2
pokeByteOff p 16 v3
return ()
foreign import ccall "git_status_foreach_ext" c'git_status_foreach_ext
:: Ptr C'git_repository -> Ptr C'git_status_options -> C'git_status_cb -> Ptr () -> IO (CInt)
foreign import ccall "&git_status_foreach_ext" p'git_status_foreach_ext
:: FunPtr (Ptr C'git_repository -> Ptr C'git_status_options -> C'git_status_cb -> Ptr () -> IO (CInt))
foreign import ccall "git_status_file" c'git_status_file
:: Ptr CUInt -> Ptr C'git_repository -> CString -> IO (CInt)
foreign import ccall "&git_status_file" p'git_status_file
:: FunPtr (Ptr CUInt -> Ptr C'git_repository -> CString -> IO (CInt))
foreign import ccall "git_status_should_ignore" c'git_status_should_ignore
:: Ptr CInt -> Ptr C'git_repository -> CString -> IO (CInt)
foreign import ccall "&git_status_should_ignore" p'git_status_should_ignore
:: FunPtr (Ptr CInt -> Ptr C'git_repository -> CString -> IO (CInt))