{-# OPTIONS_GHC -fno-warn-unused-imports #-} #include #include module Bindings.Libgit2.Config where import Foreign.Ptr #strict_import import Bindings.Libgit2.Common import Bindings.Libgit2.Types {- enum { GIT_CONFIG_LEVEL_SYSTEM = 1, GIT_CONFIG_LEVEL_XDG = 2, GIT_CONFIG_LEVEL_GLOBAL = 3, GIT_CONFIG_LEVEL_LOCAL = 4, GIT_CONFIG_HIGHEST_LEVEL = -1 }; -} #num GIT_CONFIG_LEVEL_SYSTEM #num GIT_CONFIG_LEVEL_XDG #num GIT_CONFIG_LEVEL_GLOBAL #num GIT_CONFIG_LEVEL_LOCAL #num GIT_CONFIG_HIGHEST_LEVEL {- typedef struct { const char * name; const char * value; unsigned int level; } git_config_entry; -} #starttype git_config_entry #field name , CString #field value , CString #field level , CUInt #stoptype {- typedef int (* git_config_foreach_cb)(const git_config_entry *, void *); -} #callback git_config_foreach_cb , Ptr () -> Ptr () -> IO CInt {- struct git_config_backend { unsigned int version; struct git_config * cfg; int (* open)(struct git_config_backend *, unsigned int level); int (* get)(const struct git_config_backend *, const char * key, const git_config_entry * * entry); int (* get_multivar)(struct git_config_backend *, const char * key, const char * regexp, git_config_foreach_cb callback, void * payload); int (* set)(struct git_config_backend *, const char * key, const char * value); int (* set_multivar)(git_config_backend * cfg, const char * name, const char * regexp, const char * value); int (* del)(struct git_config_backend *, const char * key); int (* foreach)(struct git_config_backend *, const char *, git_config_foreach_cb callback, void * payload); int (* refresh)(struct git_config_backend *); void (* free)(struct git_config_backend *); }; -} #callback git_config_backend_open_callback , Ptr -> CUInt -> IO CInt #callback git_config_backend_get_callback , Ptr -> CString -> Ptr (Ptr ) -> IO CInt #callback git_config_backend_get_multivar_callback , Ptr -> CString -> CString -> -> Ptr () -> IO CInt #callback git_config_backend_set_callback , Ptr -> CString -> CString -> IO CInt #callback git_config_backend_set_multivar_callback , Ptr -> CString -> CString -> CString -> IO CInt #callback git_config_backend_del_callback , Ptr -> CString -> IO CInt #callback git_config_backend_foreach_callback , Ptr -> CString -> -> Ptr () -> IO CInt #callback git_config_backend_refresh_callback , Ptr -> IO CInt #callback git_config_backend_free_callback , Ptr -> IO () #starttype git_config_backend #field version , CUInt #field cfg , Ptr #field open , #field get , #field get_multivar , #field set , #field set_multivar , #field del , #field foreach , #field refresh , #field free , #stoptype {- typedef enum { GIT_CVAR_FALSE = 0, GIT_CVAR_TRUE = 1, GIT_CVAR_INT32, GIT_CVAR_STRING } git_cvar_t; -} #integral_t git_cvar_t #num GIT_CVAR_FALSE #num GIT_CVAR_TRUE #num GIT_CVAR_INT32 #num GIT_CVAR_STRING {- typedef struct { git_cvar_t cvar_type; const char * str_match; int map_value; } git_cvar_map; -} #starttype git_cvar_map #field cvar_type , #field str_match , CString #field map_value , CInt #stoptype #ccall git_config_find_global , CString -> CSize -> IO (CInt) #ccall git_config_find_xdg , CString -> CSize -> IO (CInt) #ccall git_config_find_system , CString -> CSize -> IO (CInt) #ccall git_config_open_default , Ptr (Ptr ) -> IO (CInt) #ccall git_config_new , Ptr (Ptr ) -> IO (CInt) #ccall git_config_add_backend , Ptr -> Ptr -> CUInt -> CInt -> IO (CInt) #ccall git_config_add_file_ondisk , Ptr -> CString -> CUInt -> CInt -> IO (CInt) #ccall git_config_open_ondisk , Ptr (Ptr ) -> CString -> IO (CInt) #ccall git_config_open_level , Ptr (Ptr ) -> Ptr -> CUInt -> IO (CInt) #ccall git_config_refresh , Ptr -> IO (CInt) #ccall git_config_free , Ptr -> IO () #ccall git_config_get_entry , Ptr (Ptr ) -> Ptr -> CString -> IO (CInt) #ccall git_config_get_int32 , Ptr CInt -> Ptr -> CString -> IO (CInt) #ccall git_config_get_int64 , Ptr CLong -> Ptr -> CString -> IO (CInt) #ccall git_config_get_bool , Ptr CInt -> Ptr -> CString -> IO (CInt) #ccall git_config_get_string , Ptr (CString) -> Ptr -> CString -> IO (CInt) #ccall git_config_get_multivar , Ptr -> CString -> CString -> -> Ptr () -> IO (CInt) #ccall git_config_set_int32 , Ptr -> CString -> CInt -> IO (CInt) #ccall git_config_set_int64 , Ptr -> CString -> CLong -> IO (CInt) #ccall git_config_set_bool , Ptr -> CString -> CInt -> IO (CInt) #ccall git_config_set_string , Ptr -> CString -> CString -> IO (CInt) #ccall git_config_set_multivar , Ptr -> CString -> CString -> CString -> IO (CInt) #ccall git_config_delete_entry , Ptr -> CString -> IO (CInt) #ccall git_config_foreach , Ptr -> -> Ptr () -> IO (CInt) #ccall git_config_foreach_match , Ptr -> CString -> -> Ptr () -> IO (CInt) #ccall git_config_get_mapped , Ptr CInt -> Ptr -> CString -> Ptr -> CSize -> IO (CInt) #ccall git_config_lookup_map_value , Ptr CInt -> Ptr -> CSize -> CString -> IO (CInt) #ccall git_config_parse_bool , Ptr CInt -> CString -> IO (CInt) #ccall git_config_parse_int32 , Ptr CInt -> CString -> IO (CInt) #ccall git_config_parse_int64 , Ptr CLong -> CString -> IO (CInt)