├── .gitignore ├── LICENSE ├── README.md ├── libgit.ipkg ├── libgit_idris_wrapper ├── .gitignore ├── Makefile ├── config.mk └── libgit_idris_wrapper.c └── src ├── Libgit.idr └── Libgit ├── Clone.idr ├── Examples.idr ├── FFI.idr ├── Git.idr ├── Object.idr ├── Oid.idr ├── Remote.idr ├── Repository.idr └── Types.idr /.gitignore: -------------------------------------------------------------------------------- 1 | build/ 2 | .vscode -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2020 Cole Brown 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 19 | SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # idris2-libgit2 2 | libgit2 bindings for Idris 2 3 | 4 | ## Dependencies 5 | 6 | **C Libraries** 7 | - libgit (incl. headers) 8 | 9 | **Idris libraries** 10 | - [streaming](https://github.com/MarcelineVQ/idris2-streaming) (for 11 | Control.Monad.Managed) 12 | 13 | ## Implementation Details 14 | The library presents a minimal API for interacting with Git repositories. The 15 | Libgit.Types module defines wrapper types for libgit2 objects. Any libgit2 16 | operations requiring memory management will return `Managed` references to the 17 | types defined in Libgit.Types. Any monad transformer stack with IO should be 18 | able to comfortably impelment `MonadManaged` and make use of these functions. 19 | 20 | Libgit functions **must** be executed within an intialized Git context. This 21 | context is accessible via `withGit` as defined in Libgit.Git. `withGit` is only 22 | constrained via `HasIO` so as to permit the widest possible range of uses. Any 23 | calls to Libgit functions made outside of a `withGit` callback will have 24 | undefined behavior and will likely fail. 25 | 26 | ## Documentation / Usage 27 | Effort has been made to write thorough documentation for the public-facing API. 28 | Examples can be found in [Libgit.Examples](src/Libgit/Examples.idr). 29 | 30 | ## License 31 | See [LICENSE](LICENSE). 32 | -------------------------------------------------------------------------------- /libgit.ipkg: -------------------------------------------------------------------------------- 1 | package libgit 2 | 3 | brief = "libgit bindings for Idris 2" 4 | version = "0.1" 5 | readme = "README.md" 6 | license = "GPLv2" 7 | 8 | depends = base, contrib, streaming 9 | 10 | sourcedir = "src" 11 | 12 | modules = Libgit 13 | , Libgit.Clone 14 | , Libgit.Examples 15 | , Libgit.FFI 16 | , Libgit.Git 17 | , Libgit.Object 18 | , Libgit.Oid 19 | , Libgit.Remote 20 | , Libgit.Repository 21 | , Libgit.Types 22 | 23 | prebuild = "make -C libgit_idris_wrapper" 24 | postinstall = "make -C libgit_idris_wrapper install" 25 | postclean = "make -C libgit_idris_wrapper clean" 26 | -------------------------------------------------------------------------------- /libgit_idris_wrapper/.gitignore: -------------------------------------------------------------------------------- 1 | *.so 2 | *.d 3 | *.o -------------------------------------------------------------------------------- /libgit_idris_wrapper/Makefile: -------------------------------------------------------------------------------- 1 | include ./config.mk 2 | 3 | IDRIS := idris2 4 | INSTALLDIR = `${IDRIS} --libdir`/libgit/lib 5 | SHLIB_SUFFIX := .so 6 | 7 | TARGET = libgit_idris_wrapper 8 | 9 | LDFLAGS += -lgit2 10 | 11 | SRCS = $(wildcard *.c) 12 | OBJS = $(SRCS:.c=.o) 13 | DEPS = $(OBJS:.o=.d) 14 | 15 | 16 | all: $(TARGET)$(SHLIB_SUFFIX) 17 | 18 | $(TARGET)$(SHLIB_SUFFIX): $(OBJS) 19 | $(CC) -shared -o $@ $^ $(LDFLAGS) 20 | 21 | 22 | -include $(DEPS) 23 | 24 | %.d: %.c 25 | @$(CPP) $(CFLAGS) $< -MM -MT $(@:.d=.o) >$@ 26 | 27 | 28 | .PHONY: clean 29 | 30 | clean : 31 | rm -f $(OBJS) $(TARGET)$(SHLIB_SUFFIX) 32 | 33 | cleandep: clean 34 | rm -f $(DEPS) 35 | 36 | 37 | .PHONY: install 38 | 39 | install: 40 | @if ! [ -d $(INSTALLDIR) ]; then mkdir -p $(INSTALLDIR); fi 41 | install $(TARGET)$(SHLIB_SUFFIX) $(wildcard *.h) $(INSTALLDIR) 42 | -------------------------------------------------------------------------------- /libgit_idris_wrapper/config.mk: -------------------------------------------------------------------------------- 1 | ##### Options which a user might set before building go here ##### 2 | 3 | PREFIX ?= $(HOME)/.idris2 4 | 5 | # For Windows targets. Set to 1 to support Windows 7. 6 | OLD_WIN ?= 0 7 | 8 | ################################################################## 9 | 10 | RANLIB ?= ranlib 11 | AR ?= ar 12 | 13 | CFLAGS := -Wall $(CFLAGS) 14 | LDFLAGS := $(LDFLAGS) 15 | 16 | MACHINE := $(shell $(CC) -dumpmachine) 17 | ifneq (,$(findstring cygwin, $(MACHINE))) 18 | OS := windows 19 | SHLIB_SUFFIX := .dll 20 | else ifneq (,$(findstring mingw, $(MACHINE))) 21 | OS := windows 22 | SHLIB_SUFFIX := .dll 23 | else ifneq (,$(findstring windows, $(MACHINE))) 24 | OS := windows 25 | SHLIB_SUFFIX := .dll 26 | else ifneq (,$(findstring darwin, $(MACHINE))) 27 | OS := darwin 28 | SHLIB_SUFFIX := .dylib 29 | CFLAGS += -fPIC 30 | else ifneq (, $(findstring bsd, $(MACHINE))) 31 | OS := bsd 32 | SHLIB_SUFFIX := .so 33 | CFLAGS += -fPIC 34 | else 35 | OS := linux 36 | SHLIB_SUFFIX := .so 37 | CFLAGS += -fPIC 38 | endif 39 | export OS 40 | 41 | ifeq ($(OS),bsd) 42 | MAKE := gmake 43 | else 44 | MAKE := make 45 | endif 46 | export MAKE 47 | 48 | # Add a custom.mk file to override any of the configurations 49 | -include custom.mk 50 | -------------------------------------------------------------------------------- /libgit_idris_wrapper/libgit_idris_wrapper.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | int git_clone_options_version() { 6 | return GIT_CLONE_OPTIONS_VERSION; 7 | } 8 | 9 | typedef struct { 10 | void *obj; 11 | int result; 12 | } git_result; 13 | 14 | void *identity(void *ptr) { 15 | return ptr; 16 | } 17 | 18 | git_result *git_clone_repository(const char *url, const char *local_path, git_clone_options *options) { 19 | git_repository *repo = NULL; 20 | int result = git_clone(&repo, url, local_path, options); 21 | git_result *out = malloc(sizeof(git_result)); 22 | out->obj = repo; 23 | out->result = result; 24 | return out; 25 | } 26 | 27 | git_result *git_open_repository(const char *path) { 28 | git_repository *repo = NULL; 29 | int result = git_repository_open(&repo, path); 30 | git_result *out = malloc(sizeof(git_result)); 31 | out->obj = repo; 32 | out->result = result; 33 | return out; 34 | } 35 | 36 | git_clone_options *make_clone_options() { 37 | return (git_clone_options *)malloc(sizeof(git_clone_options)); 38 | } 39 | 40 | void *make_string(char *str) { 41 | return (void *)str; 42 | } 43 | 44 | int is_null(void *ptr) { 45 | return ptr == NULL; 46 | } 47 | 48 | void *null_string() { 49 | return NULL; 50 | } 51 | 52 | char *get_string(void *strptr) { 53 | char *str = (char *)strptr; 54 | const int bytes = strlen(str) + 1; 55 | char *copy = (char *)(malloc(bytes)); 56 | memcpy(copy, str, bytes); 57 | return str; 58 | } 59 | 60 | void apply_clone_options(git_clone_options *opts, char *branch, int bare) { 61 | opts->checkout_branch = branch; 62 | opts->bare = bare; 63 | } 64 | 65 | git_result *git_oid_from_string(const char *oid_str) { 66 | git_oid *oid = (git_oid *)malloc(sizeof(git_oid)); 67 | int result = git_oid_fromstrp(oid, oid_str); 68 | git_result *out = malloc(sizeof(git_result)); 69 | out->obj = oid; 70 | out->result = result; 71 | return out; 72 | } 73 | 74 | char *git_oid_to_string(git_oid *oid) { 75 | size_t len = GIT_OID_HEXSZ+1; 76 | char *oid_str = (char *)malloc(len); 77 | return git_oid_tostr(oid_str, len, oid); 78 | } 79 | 80 | git_result *git_lookup_object(git_repository *repo, const git_oid *oid, git_otype type) { 81 | git_object *obj = NULL; 82 | int result = git_object_lookup(&obj, repo, oid, type); 83 | git_result *out = malloc(sizeof(git_result)); 84 | out->obj = obj; 85 | out->result = result; 86 | return out; 87 | } 88 | 89 | git_result *git_checkout_options_init() { 90 | git_checkout_options *opts = malloc(sizeof(git_checkout_options)); 91 | int result = git_checkout_init_options(opts, GIT_CHECKOUT_OPTIONS_VERSION); 92 | git_result *out = malloc(sizeof(git_result)); 93 | out->obj = opts; 94 | out->result = result; 95 | return out; 96 | } 97 | 98 | git_result *git_fetch_options_init() { 99 | git_fetch_options *opts = malloc(sizeof(git_fetch_options)); 100 | int result = git_fetch_init_options(opts, GIT_FETCH_OPTIONS_VERSION); 101 | git_result *out = malloc(sizeof(git_result)); 102 | out->obj = opts; 103 | out->result = result; 104 | return out; 105 | } 106 | 107 | git_result *git_single_revparse(git_repository *repo, const char *spec) { 108 | git_object *obj = NULL; 109 | int result = git_revparse_single(&obj, repo, spec); 110 | git_result *out = malloc(sizeof(git_result)); 111 | out->obj = obj; 112 | out->result = result; 113 | return out; 114 | } 115 | 116 | git_result *git_lookup_remote(git_repository *repo, const char *name) { 117 | git_remote *remote = NULL; 118 | int result = git_remote_lookup(&remote, repo, name); 119 | git_result *out = malloc(sizeof(git_result)); 120 | out->obj = remote; 121 | out->result = result; 122 | return out; 123 | } 124 | -------------------------------------------------------------------------------- /src/Libgit.idr: -------------------------------------------------------------------------------- 1 | module Libgit 2 | 3 | import Prelude 4 | import System.FFI 5 | 6 | import public Libgit.Clone 7 | import Libgit.FFI 8 | import public Libgit.Git 9 | import public Libgit.Remote 10 | import public Libgit.Repository 11 | import public Libgit.Object 12 | import public Libgit.Oid 13 | import public Libgit.Types 14 | -------------------------------------------------------------------------------- /src/Libgit/Clone.idr: -------------------------------------------------------------------------------- 1 | module Libgit.Clone 2 | 3 | import Prelude 4 | import Control.Monad.Managed 5 | import Control.Monad.Reader 6 | import Control.Monad.State 7 | import Control.Monad.Syntax 8 | import Control.Monad.Trans 9 | import System.FFI 10 | 11 | import Libgit.FFI 12 | import Libgit.Git 13 | import Libgit.Types 14 | 15 | ||| A set of options that dictate how a repository should be cloned from a 16 | ||| remote. 17 | public export 18 | record CloneOpts where 19 | constructor MkCloneOpts 20 | ||| Make a bare Git repository. When enabled, the localPath provided to clone 21 | ||| will contain the administrative files usually contained within .git and 22 | ||| files won't actually be checked out. 23 | bare : Bool 24 | ||| Which branch to checkout after cloning. 25 | checkoutBranch : String 26 | 27 | ||| Sensible defaults for CloneOpts. 28 | ||| + bare = False 29 | ||| + checkoutBranch = master 30 | export 31 | defaultOpts : CloneOpts 32 | defaultOpts = MkCloneOpts False "master" 33 | 34 | applyOpts : CloneOpts -> AnyPtr -> IO () 35 | applyOpts cloneOpts cCloneOpts = do 36 | let bare' = cBool cloneOpts.bare 37 | primIO $ prim_apply_clone_options cCloneOpts cloneOpts.checkoutBranch bare' 38 | 39 | withCloneOptions : CloneOpts -> (GitResult AnyPtr -> IO a) -> IO a 40 | withCloneOptions opts act = do 41 | optsPtr <- primIO prim_init_clone_options 42 | err <- primIO (prim_git_clone_init_options optsPtr git_clone_options_version) 43 | applyOpts opts optsPtr 44 | res <- act (toGitResult err optsPtr) 45 | primIO (prim_free optsPtr) 46 | pure res 47 | 48 | cloneOptions : CloneOpts -> Managed (GitResult AnyPtr) 49 | cloneOptions opts = managed (withCloneOptions opts) 50 | 51 | withClonedRepository : (url : String) 52 | -> (localPath : String) 53 | -> (options : AnyPtr) 54 | -> (GitResult GitRepository -> IO a) 55 | -> IO a 56 | withClonedRepository url localPath options act = do 57 | cresult <- primIO (prim_git_clone_repository url localPath options) 58 | repoResult <- getGitResult cresult 59 | result <- act (MkGitRepository <$> repoResult) 60 | case repoResult of 61 | Right ptr => pure result <* primIO (prim_git_repository_free ptr) 62 | _ => pure result 63 | 64 | ||| Accepts clone options, a Git remote URL, and a local path, and clones the 65 | ||| Git repository at that remote to the specified local path. 66 | ||| 67 | ||| Returns a Managed reference to a GitRepository object which can be used to 68 | ||| interact with the repository. 69 | ||| 70 | ||| @opts A CloneOpts specifying additional details about how the 71 | ||| repository should be cloned. 72 | ||| @url A reference to the 73 | ||| @localPath The local path to clone the repository to. 74 | export 75 | clonedRepository : (opts : CloneOpts) 76 | -> (url : String) 77 | -> (localPath : String) 78 | -> Managed (GitResult GitRepository) 79 | clonedRepository opts url localPath = do 80 | Right options <- cloneOptions opts 81 | | Left res => pure (Left res) 82 | managed (withClonedRepository url localPath options) 83 | -------------------------------------------------------------------------------- /src/Libgit/Examples.idr: -------------------------------------------------------------------------------- 1 | module Libgit.Examples 2 | 3 | import Control.Monad.Managed 4 | 5 | import Libgit 6 | 7 | -- Clone a repository and print some information about the success of the 8 | -- operation. 9 | export 10 | testClone : String -> String -> String -> IO () 11 | testClone url localPath branch = do 12 | res <- withGit $ runManaged $ do 13 | eRes <- repository (GitRepositoryClone (MkCloneOpts False branch) url localPath) 14 | let result = case eRes of 15 | Left res => "Error: " ++ show res 16 | Right _ => "Cloned repository" 17 | liftIO $ putStrLn result 18 | case res of 19 | Left err => putStrLn ("Error initializing: " ++ show err) 20 | Right _ => putStrLn "Success" 21 | 22 | -- Open a repository and reset its head to a given commit/tag 23 | export 24 | resetRepo : (path : String) -> (rev : String) -> IO () 25 | resetRepo path rev = do 26 | withGit $ runManaged $ do 27 | Right repo <- repository (GitRepositoryOpen path) 28 | | Left err => putStrLn ("Error opening repo: " ++ show err) 29 | Right (objTyp ** obj) <- revParse repo rev 30 | | Left err => putStrLn ("Error parsing revision: " ++ show err) 31 | case objTyp of 32 | GitObjectCommit => liftIO resetRepo 33 | GitObjectTag => liftIO resetRepo 34 | _ => liftIO (putStrLn "Wrong object type") 35 | pure () 36 | where 37 | resetRepo : {auto repo : GitRepository} 38 | -> {auto typ : GitObjectType} 39 | -> {auto obj : GitObject typ} 40 | -> {auto 0 prf : IsCommitish typ} 41 | -> IO () 42 | resetRepo {repo} {obj} = do 43 | 0 <- liftIO (resetRepository repo obj GitResetHard) 44 | | err => putStrLn ("Error resetting repo: " ++ show err) 45 | putStrLn "Successfully reset repo" 46 | 47 | -- Open a repository and fetch a remote 48 | export 49 | fetchRemote : (path : String) -> (remote : String) -> IO () 50 | fetchRemote path rev = do 51 | withGit $ runManaged $ do 52 | Right repo <- repository (GitRepositoryOpen path) 53 | | Left err => putError ("Error opening repo: " ++ show err) 54 | Right remote <- remote repo "origin" 55 | | Left err => putError ("Error looking up remote: " ++ show err) 56 | 0 <- liftIO (remoteFetch' remote "Fetched from Idris") 57 | | err => putError ("Error fetching remote: " ++ show err) 58 | putStrLn "Fetch successful." 59 | pure () 60 | where 61 | putError : HasIO io => String -> io () 62 | putError msg = liftIO $ do 63 | putStrLn msg 64 | case lastError of 65 | Just (msg, _) => putStrLn msg 66 | Nothing => putStrLn "No git error present" -------------------------------------------------------------------------------- /src/Libgit/FFI.idr: -------------------------------------------------------------------------------- 1 | module Libgit.FFI 2 | 3 | import Prelude 4 | import System.FFI 5 | 6 | import Libgit.Types 7 | 8 | -- FFI string builders 9 | 10 | public export 11 | libgit : String -> String 12 | libgit fn = "C:" ++ fn ++ ",libgit2" 13 | 14 | public export 15 | libgitWrapper : String -> String 16 | libgitWrapper fn = "C:" ++ fn ++ ",libgit_idris_wrapper" 17 | 18 | -- Structs 19 | 20 | export 21 | CGitResult : Type 22 | CGitResult = Struct "git_result" [ 23 | ("obj", AnyPtr), 24 | ("result", Int) 25 | ] 26 | 27 | export 28 | %foreign "C:free,libc" 29 | prim_free : AnyPtr -> PrimIO () 30 | 31 | %foreign (libgitWrapper "identity") 32 | derefResult : Ptr CGitResult -> CGitResult 33 | 34 | export 35 | getGitResultPair : Ptr CGitResult -> IO (Int, AnyPtr) 36 | getGitResultPair cgrPtr = do 37 | let cgr : CGitResult = derefResult cgrPtr 38 | err : Int = getField cgr "result" 39 | ptr : AnyPtr = getField cgr "obj" 40 | primIO (prim_free (prim__forgetPtr cgrPtr)) 41 | pure (err, ptr) 42 | 43 | export 44 | getGitResult : Ptr CGitResult -> IO (GitResult AnyPtr) 45 | getGitResult cgrPtr = do 46 | (err, ptr) <- getGitResultPair cgrPtr 47 | case err of 48 | 0 => pure (Right ptr) 49 | _ => pure (Left err) 50 | 51 | public export 52 | CGitError : Type 53 | CGitError = Struct "git_error" [ 54 | ("message", Ptr String), 55 | ("klass", Int) 56 | ] 57 | 58 | export 59 | %foreign (libgitWrapper "identity") 60 | derefGitError : Ptr CGitError -> CGitError 61 | 62 | -- System info helpers 63 | ---- These should be generated by the build system until type providers exist 64 | 65 | CUInt : Type 66 | CUInt = Bits32 67 | 68 | CSizeT : Type 69 | CSizeT = Bits32 70 | 71 | -- FFI functions 72 | 73 | export 74 | %foreign (libgitWrapper "make_string") 75 | make_string : String -> Ptr String 76 | 77 | export 78 | %foreign (libgitWrapper "is_null") 79 | is_null_string : Ptr String -> Int 80 | 81 | export 82 | %foreign (libgitWrapper "is_null") 83 | is_null_ptr : AnyPtr -> Int 84 | 85 | export 86 | %foreign (libgitWrapper "get_string") 87 | getString : Ptr String -> String 88 | 89 | export 90 | %foreign (libgitWrapper "null_string") 91 | null_string : Ptr String 92 | 93 | export 94 | %foreign (libgitWrapper "null_string") 95 | null_ptr : AnyPtr 96 | 97 | export 98 | %foreign (libgit "git_libgit2_init") 99 | prim_libgit_init : PrimIO Int 100 | 101 | export 102 | %foreign (libgit "git_libgit2_shutdown") 103 | prim_libgit_shutdown : PrimIO Int 104 | 105 | export 106 | %foreign (libgitWrapper "apply_clone_options") 107 | prim_apply_clone_options : AnyPtr -> String -> Int -> PrimIO () 108 | 109 | export 110 | %foreign (libgitWrapper "make_clone_options") 111 | prim_init_clone_options : PrimIO AnyPtr 112 | 113 | export 114 | %foreign (libgitWrapper "git_clone_options_version") 115 | git_clone_options_version : Int 116 | 117 | export 118 | %foreign (libgit "git_clone_init_options") 119 | prim_git_clone_init_options : AnyPtr -> Int -> PrimIO Int 120 | 121 | export 122 | %foreign (libgitWrapper "git_clone_repository") 123 | prim_git_clone_repository : String -> String -> AnyPtr -> PrimIO (Ptr CGitResult) 124 | 125 | export 126 | %foreign (libgit "git_repository_free") 127 | prim_git_repository_free : AnyPtr -> PrimIO () 128 | 129 | export 130 | %foreign (libgitWrapper "git_open_repository") 131 | prim_git_open_repository : String -> PrimIO (Ptr CGitResult) 132 | 133 | export 134 | %foreign (libgitWrapper "git_checkout_options_init") 135 | git_checkout_options_init : Ptr CGitResult 136 | 137 | export 138 | %foreign (libgitWrapper "git_fetch_options_init") 139 | git_fetch_options_init : Ptr CGitResult 140 | 141 | export 142 | %foreign (libgit "git_reset") 143 | prim_git_reset : AnyPtr -> AnyPtr -> Int -> AnyPtr -> PrimIO Int 144 | 145 | export 146 | %foreign (libgitWrapper "git_oid_from_string") 147 | git_oid_from_string : String -> Ptr CGitResult 148 | 149 | export 150 | %foreign (libgitWrapper "git_oid_to_string") 151 | git_oid_to_string : AnyPtr -> String 152 | 153 | export 154 | %foreign (libgitWrapper "git_lookup_object") 155 | git_lookup_object : AnyPtr -> AnyPtr -> Int -> Ptr CGitResult 156 | 157 | export 158 | %foreign (libgitWrapper "git_single_revparse") 159 | prim_git_single_revparse : AnyPtr -> String -> PrimIO (Ptr CGitResult) 160 | 161 | export 162 | %foreign (libgit "git_object_free") 163 | prim_git_object_free : AnyPtr -> PrimIO () 164 | 165 | export 166 | %foreign (libgit "git_object_type") 167 | git_object_type : AnyPtr -> Int 168 | 169 | export 170 | %foreign (libgitWrapper "git_lookup_remote") 171 | git_lookup_remote : AnyPtr -> String -> Ptr CGitResult 172 | 173 | export 174 | %foreign (libgit "git_remote_free") 175 | prim_git_remote_free : AnyPtr -> PrimIO () 176 | 177 | export 178 | %foreign (libgit "git_remote_fetch") 179 | prim_git_remote_fetch : AnyPtr -> AnyPtr -> AnyPtr -> Ptr String -> PrimIO Int 180 | 181 | export 182 | %foreign (libgit "giterr_last") 183 | git_error_last : Ptr CGitError 184 | 185 | export 186 | liftPIO : (HasIO m) => PrimIO a -> m a 187 | liftPIO action = liftIO (primIO action) 188 | 189 | export 190 | cBool : Bool -> Int 191 | cBool True = 1 192 | cBool False = 0 193 | -------------------------------------------------------------------------------- /src/Libgit/Git.idr: -------------------------------------------------------------------------------- 1 | module Libgit.Git 2 | 3 | import System.FFI 4 | 5 | import Libgit.FFI 6 | import Libgit.Types 7 | 8 | ||| Runs some action within an initialized Git context. Initializes libgit2 9 | ||| static memory before running the action and shuts it down after running the 10 | ||| action. All managed Git resources must be accessed from within this context. 11 | export 12 | withGit : HasIO io => io b -> io (Either Int b) 13 | withGit act = do 14 | err <- liftIO (primIO prim_libgit_init) 15 | case err < 0 of 16 | True => pure (Left err) 17 | False => do 18 | res <- act 19 | liftIO (primIO prim_libgit_shutdown) 20 | pure (Right res) 21 | 22 | ||| Get the last Git error, if present. 23 | ||| 24 | ||| Returns a tuple of a git error message and an error class code if a Git 25 | ||| error is present. 26 | export 27 | lastError : Maybe (String, Int) 28 | lastError = 29 | let ptr = git_error_last in 30 | case is_null_ptr (prim__forgetPtr ptr) of 31 | 1 => Nothing 32 | _ => let giterr = derefGitError ptr 33 | message = getField giterr "message" 34 | klass = getField giterr "klass" 35 | messageStr = getString message in 36 | Just (messageStr, klass) 37 | -------------------------------------------------------------------------------- /src/Libgit/Object.idr: -------------------------------------------------------------------------------- 1 | module Libgit.Object 2 | 3 | import Control.Monad.Managed 4 | 5 | import Libgit.FFI 6 | import Libgit.Oid 7 | import Libgit.Types 8 | 9 | enrichGitObject : AnyPtr -> (typ ** GitObject typ) 10 | enrichGitObject ptr = 11 | let objTyp = gitObjectTypeFromInt (git_object_type ptr) in 12 | (objTyp ** MkGitObject ptr) 13 | 14 | withGitObject : GitRepository 15 | -> GitOid 16 | -> (GitResult (typ ** GitObject typ) -> IO a) 17 | -> IO a 18 | withGitObject (MkGitRepository repoPtr) (MkGitOid oidPtr) act = do 19 | let cgr = git_lookup_object repoPtr oidPtr (gitObjectTypeToInt GitObjectAny) 20 | result <- getGitResult cgr 21 | let objResult = enrichGitObject <$> result 22 | actResult <- act objResult 23 | case result of 24 | Right ptr => pure actResult <* primIO (prim_git_object_free ptr) 25 | Left _ => pure actResult 26 | 27 | ||| Retrieve an object of any type from a Git repository. 28 | ||| 29 | ||| Returns on success a dependent pair of the object's type and a managed 30 | ||| reference to the object. 31 | ||| Returns on failure a Git error code. 32 | ||| 33 | ||| @repo The GitRepository to retrieve the object from. 34 | ||| @oid The object ID to retrieve from the repository. 35 | export 36 | gitObject : (repo : GitRepository) 37 | -> (oid : GitOid) 38 | -> Managed (GitResult (typ ** GitObject typ)) 39 | gitObject repo oid = managed (withGitObject repo oid) 40 | 41 | ||| Retrieve an object of any type from a Git repository based on the object 42 | ||| ID's string representation. 43 | ||| 44 | ||| Returns on success a dependent pair of the object's type and a managed 45 | ||| reference to the object. 46 | ||| Returns on failure a Git error code. 47 | ||| 48 | ||| @repo The GitRepository to retrieve the object from. 49 | ||| @str The string representation of an object ID. 50 | export 51 | gitObjectFromString : GitRepository 52 | -> String 53 | -> Managed (GitResult (typ ** GitObject typ)) 54 | gitObjectFromString repo str = do 55 | Right oid <- oidFromString str 56 | | Left err => pure (Left err) 57 | gitObject repo oid 58 | 59 | withParsedRev : (repo : GitRepository) 60 | -> (rev : String) 61 | -> (GitResult (typ ** GitObject typ) -> IO a) 62 | -> IO a 63 | withParsedRev (MkGitRepository repo) rev act = do 64 | cgr <- primIO (prim_git_single_revparse repo rev) 65 | (err, ptr) <- getGitResultPair cgr 66 | let revResult = enrichGitObject <$> toGitResult err ptr 67 | result <- act revResult 68 | primIO (prim_git_object_free ptr) 69 | pure result 70 | 71 | ||| Parse a formatted revision string into a Git object. 72 | ||| 73 | ||| Returns on success a managed reference to the Git object. 74 | ||| Returns on failure a Git error code. 75 | ||| 76 | ||| @repo The Git repository to perform the lookup in. 77 | ||| @rev The string, formatted per the git revision spec 78 | ||| http://git-scm.com/docs/git-rev-parse.html#_specifying_revisions), 79 | ||| to parse into an object. 80 | export 81 | revParse : (repo : GitRepository) 82 | -> (rev : String) 83 | -> Managed (GitResult (typ ** GitObject typ)) 84 | revParse repo rev = managed (withParsedRev repo rev) 85 | 86 | withTypedGitObject : GitRepository 87 | -> GitOid 88 | -> (typ : GitObjectType) 89 | -> (GitResult (GitObject typ) -> IO a) 90 | -> IO a 91 | withTypedGitObject (MkGitRepository repoPtr) (MkGitOid oidPtr) typ act = do 92 | let cgr = git_lookup_object repoPtr oidPtr (gitObjectTypeToInt typ) 93 | result <- getGitResult cgr 94 | actResult <- act (MkGitObject <$> result) 95 | case result of 96 | Right ptr => pure actResult <* primIO (prim_git_object_free ptr) 97 | Left _ => pure actResult 98 | 99 | ||| Retrieve an object of a specific type from a Git repository. 100 | ||| 101 | ||| Returns on success a managed reference to the object. 102 | ||| Returns on failure a Git error code. 103 | ||| 104 | ||| @repo The GitRepository to retrieve the object from. 105 | ||| @oid The object ID to retrieve from the repository. 106 | ||| @typ The GitObjectType of the object to retrieve. 107 | export 108 | typedGitObject : GitRepository 109 | -> GitOid 110 | -> (typ : GitObjectType) 111 | -> Managed (GitResult (GitObject typ)) 112 | typedGitObject repo oid typ = managed (withTypedGitObject repo oid typ) 113 | 114 | ||| Retrieve an object of a specific type from a Git repository based on the 115 | ||| object ID's string representation. 116 | ||| 117 | ||| Returns on success a managed reference to the object. 118 | ||| Returns on failure a Git error code. 119 | ||| 120 | ||| @repo The GitRepository to retrieve the object from. 121 | ||| @str The string representation of an object ID. 122 | ||| @typ The GitObjectType of the object to retrieve. 123 | export 124 | typedGitObjectFromString : GitRepository 125 | -> String 126 | -> (typ : GitObjectType) 127 | -> Managed (GitResult (GitObject typ)) 128 | typedGitObjectFromString repo str typ = do 129 | Right oid <- oidFromString str 130 | | Left err => pure (Left err) 131 | managed (withTypedGitObject repo oid typ) 132 | -------------------------------------------------------------------------------- /src/Libgit/Oid.idr: -------------------------------------------------------------------------------- 1 | module Libgit.Oid 2 | 3 | import Control.Monad.Managed 4 | 5 | import Libgit.FFI 6 | import Libgit.Types 7 | 8 | withOidFromString : String -> (GitResult GitOid -> IO a) -> IO a 9 | withOidFromString str act = do 10 | let cresult = git_oid_from_string str 11 | (err, ptr) <- getGitResultPair cresult 12 | res <- act (MkGitOid <$> toGitResult err ptr) 13 | primIO (prim_free ptr) 14 | pure res 15 | 16 | ||| Attempt to parse a Git Object ID from a string 17 | ||| 18 | ||| Returns on success a managed reference to an object ID 19 | ||| Returns on failure a Git error code 20 | ||| 21 | ||| @str a string representation of an object ID 22 | export 23 | oidFromString : (str : String) -> Managed (GitResult GitOid) 24 | oidFromString str = managed (withOidFromString str) 25 | 26 | ||| Generate a hex-string representation of an object id 27 | export 28 | gitOidToString : GitOid -> String 29 | gitOidToString (MkGitOid oid) = git_oid_to_string oid 30 | -------------------------------------------------------------------------------- /src/Libgit/Remote.idr: -------------------------------------------------------------------------------- 1 | module Libgit.Remote 2 | 3 | import Control.Monad.Managed 4 | 5 | import Libgit.FFI 6 | import Libgit.Types 7 | 8 | withRemote : GitRepository -> String -> (GitResult GitRemote -> IO a) -> IO a 9 | withRemote (MkGitRepository repoPtr) name act = do 10 | let cgr = git_lookup_remote repoPtr name 11 | (err, ptr) <- getGitResultPair cgr 12 | res <- act (MkGitRemote <$> toGitResult err ptr) 13 | primIO (prim_git_remote_free ptr) 14 | pure res 15 | 16 | ||| Lookup a repository remote by its name. 17 | ||| 18 | ||| Returns on success a managed reference to a Git remote 19 | ||| Returns on failure a Git error code. 20 | ||| 21 | ||| @repo The Git repository. 22 | ||| @name The string name of the remote. 23 | export 24 | remote : (repo : GitRepository) 25 | -> (name : String) 26 | -> Managed (GitResult GitRemote) 27 | remote repo name = managed (withRemote repo name) 28 | 29 | ||| Download new data and update tips from a Git remote. 30 | ||| 31 | ||| Returns a Git error code. 32 | ||| 33 | ||| @remote The Git remote to fetch. 34 | export 35 | remoteFetch : (remote : GitRemote) -> IO Int 36 | remoteFetch (MkGitRemote remote) = do 37 | let cgr = git_fetch_options_init 38 | (0, ptr) <- getGitResultPair cgr 39 | | (err, ptr) => pure err <* primIO (prim_free ptr) 40 | res <- primIO (prim_git_remote_fetch remote null_ptr ptr null_string) 41 | pure res <* primIO (prim_free ptr) 42 | 43 | ||| Download new data and update tips from a Git remote. 44 | ||| 45 | ||| Returns a Git error code. 46 | ||| 47 | ||| @remote The Git remote to fetch. 48 | ||| @reflogMessage The message to write in the reflog for this fetch. 49 | export 50 | remoteFetch' : (remote : GitRemote) 51 | -> (reflogMessage : String) 52 | -> IO Int 53 | remoteFetch' (MkGitRemote remote) reflogMessage = do 54 | let cgr = git_fetch_options_init 55 | (0, ptr) <- getGitResultPair cgr 56 | | (err, ptr) => pure err <* primIO (prim_free ptr) 57 | res <- primIO (prim_git_remote_fetch remote null_ptr ptr (make_string reflogMessage)) 58 | pure res <* primIO (prim_free ptr) 59 | -------------------------------------------------------------------------------- /src/Libgit/Repository.idr: -------------------------------------------------------------------------------- 1 | module Libgit.Repository 2 | 3 | import Control.Monad.Managed 4 | 5 | import Libgit.Clone 6 | import Libgit.FFI 7 | import Libgit.Git 8 | import Libgit.Types 9 | 10 | ||| A sum type representing the different ways to instantiate a GitRepository. 11 | public export 12 | data GitRepositoryOptions : Type where 13 | ||| Clone a repository given options, a URL, and a local path. 14 | GitRepositoryClone : CloneOpts -> (url : String) -> (localPath : String) -> GitRepositoryOptions 15 | ||| Open an existing repository using a local path. 16 | GitRepositoryOpen : (path : String) -> GitRepositoryOptions 17 | 18 | withOpenedRepository : (path : String) 19 | -> (action : (GitResult GitRepository -> IO a) 20 | -> IO a 21 | withOpenedRepository path act = do 22 | cresult <- primIO (prim_git_open_repository path) 23 | result <- getGitResult cresult 24 | res <- act (MkGitRepository <$> result) 25 | case result of 26 | Left _ => pure res 27 | Right ptr => pure res <* primIO (prim_git_repository_free ptr) 28 | 29 | ||| Opens an existing Git repository. 30 | ||| 31 | ||| Returns the Git repository pointed to by the provided path. 32 | ||| 33 | ||| @path Local path to the Git repository. 34 | export 35 | openedRepository : (path : String) 36 | -> Managed (GitResult GitRepository) 37 | openedRepository path = managed (withOpenedRepository path) 38 | 39 | ||| Given GitRepositoryOptions, obtain a managed reference to a GitRepository 40 | ||| by cloning a repository or opening an existing repository. 41 | ||| 42 | ||| Returns a managed reference to a GitRepository. 43 | ||| 44 | ||| @options A GitRepositoryOptions specifying the strategy to use. 45 | export 46 | repository : (options : GitRepositoryOptions) 47 | -> Managed (GitResult GitRepository) 48 | repository (GitRepositoryClone opts url localPath) = clonedRepository opts url localPath 49 | repository (GitRepositoryOpen path) = openedRepository path 50 | 51 | ||| A sum type representing the various strategies for git reset. 52 | ||| 53 | ||| + GitResetSoft - Move the head to the given commit 54 | ||| + GitResetMixed - Soft plus reset index to the commit 55 | ||| + GitResetHard - Mixed plus changes in working tree discarded 56 | public export 57 | data GitResetType = 58 | GitResetSoft 59 | | GitResetMixed 60 | | GitResetHard 61 | 62 | gitResetTypeToInt : GitResetType -> Int 63 | gitResetTypeToInt GitResetSoft = 1 64 | gitResetTypeToInt GitResetMixed = 2 65 | gitResetTypeToInt GitResetHard = 3 66 | 67 | ||| Set the current head to a commit or tag. 68 | ||| 69 | ||| Returns a Git error code. 70 | ||| 71 | ||| @repo The Git repository containing the commit or tag. 72 | ||| @obj The Git object (must be either a commit or a tag) to set HEAD to. 73 | ||| @rst The type of reset to perform. An instance of GitResetType. 74 | export 75 | resetRepository : (repo : GitRepository) 76 | -> {typ : GitObjectType} 77 | -> {auto 0 prf : IsCommitish typ} 78 | -> (obj : GitObject typ) 79 | -> (rst : GitResetType) 80 | -> IO Int 81 | resetRepository (MkGitRepository repoPtr) (MkGitObject objPtr) resetType = do 82 | let rt = gitResetTypeToInt resetType 83 | cgrOptions = git_checkout_options_init 84 | (err, optsPtr) <- getGitResultPair cgrOptions 85 | let freeOpts = primIO (prim_free optsPtr) 86 | case err of 87 | 0 => do 88 | res <- primIO (prim_git_reset repoPtr objPtr rt optsPtr) 89 | pure res <* freeOpts 90 | _ => pure err <* freeOpts 91 | -------------------------------------------------------------------------------- /src/Libgit/Types.idr: -------------------------------------------------------------------------------- 1 | module Libgit.Types 2 | 3 | import System.FFI 4 | 5 | ||| A simple type alias for Git results which can either return a non-zero 6 | ||| integer error code or a result. 7 | public export 8 | GitResult : Type -> Type 9 | GitResult a = Either Int a 10 | 11 | ||| Given an error code and some object, create a GitResult. 12 | export 13 | toGitResult : Int -> a -> GitResult a 14 | toGitResult err x = case err < 0 of 15 | True => Left err 16 | False => Right x 17 | 18 | ||| An opaque type representing a Git repository. 19 | public export 20 | data GitRepository : Type where 21 | MkGitRepository : AnyPtr -> GitRepository 22 | 23 | ||| An opaque type representing a Git object id. 24 | public export 25 | data GitOid : Type where 26 | MkGitOid : AnyPtr -> GitOid 27 | 28 | ||| Git object types 29 | public export 30 | data GitObjectType = GitObjectAny 31 | | GitObjectBad 32 | | GitObjectCommit 33 | | GitObjectTree 34 | | GitObjectBlob 35 | | GitObjectTag 36 | | GitObjectOfsDelta 37 | | GitObjectRefDelta 38 | 39 | public export 40 | data IsCommitish : GitObjectType -> Type where 41 | IsCommitishCommit : IsCommitish GitObjectCommit 42 | IsCommitishTag : IsCommitish GitObjectTag 43 | 44 | export 45 | gitObjectTypeToInt : GitObjectType -> Int 46 | gitObjectTypeToInt GitObjectAny = -2 47 | gitObjectTypeToInt GitObjectBad = -1 48 | gitObjectTypeToInt GitObjectCommit = 1 49 | gitObjectTypeToInt GitObjectTree = 2 50 | gitObjectTypeToInt GitObjectBlob = 3 51 | gitObjectTypeToInt GitObjectTag = 4 52 | gitObjectTypeToInt GitObjectOfsDelta = 6 53 | gitObjectTypeToInt GitObjectRefDelta = 7 54 | 55 | export 56 | gitObjectTypeFromInt : Int -> GitObjectType 57 | gitObjectTypeFromInt x = case x of 58 | 1 => GitObjectCommit 59 | 2 => GitObjectTree 60 | 3 => GitObjectBlob 61 | 4 => GitObjectTag 62 | 6 => GitObjectOfsDelta 63 | 7 => GitObjectRefDelta 64 | _ => if x == -2 65 | then GitObjectAny 66 | else GitObjectBad -- This is kind of a hack, but kind of not. 67 | 68 | public export 69 | data GitObject : (typ : GitObjectType) -> Type where 70 | MkGitObject : AnyPtr -> GitObject typ 71 | 72 | public export 73 | data GitRemote : Type where 74 | MkGitRemote : AnyPtr -> GitRemote 75 | --------------------------------------------------------------------------------