diff --git a/Data/Git/Backend.hs b/Data/Git/Backend.hs --- a/Data/Git/Backend.hs +++ b/Data/Git/Backend.hs @@ -42,8 +42,8 @@ odbBackendAdd :: Repository -> Ptr C'git_odb_backend -> Int -> IO (Result Repository) -odbBackendAdd repo' backend priority = - withForeignPtr repo $ \repoPtr -> +odbBackendAdd repo backend priority = + withForeignPtr (repoObj repo) $ \repoPtr -> alloca $ \odbPtr -> do r <- c'git_repository_odb odbPtr repoPtr if r < 0 @@ -53,9 +53,6 @@ r2 <- c'git_odb_add_backend odb backend (fromIntegral priority) if r2 < 0 then return (Left "Cannot add backend to repository ODB") - else return (Right repo') - - where - repo = fromMaybe (throw RepositoryInvalid) (repoObj repo') + else return (Right repo) -- Backend.hs diff --git a/Data/Git/Blob.hs b/Data/Git/Blob.hs --- a/Data/Git/Blob.hs +++ b/Data/Git/Blob.hs @@ -122,20 +122,17 @@ -- jww (2012-12-14): Have the write functions return Either instead doWriteBlob :: Blob -> IO COid doWriteBlob b = do - ptr <- mallocForeignPtr - r <- withForeignPtr repo (createFromBuffer ptr) - when (r < 0) $ throwIO BlobCreateFailed - return (COid ptr) + ptr <- mallocForeignPtr + r <- withForeignPtr (repoObj (gitRepo (blobInfo b))) + (createFromBuffer ptr) + when (r < 0) $ throwIO BlobCreateFailed + return (COid ptr) where - repo = fromMaybe (error "Repository invalid") - (repoObj (gitRepo (blobInfo b))) - - createFromBuffer ptr repoPtr = do - str <- blobSourceToString (blobContents b) - case str of - Nothing -> throw BlobCreateFailed - Just str' -> createBlobFromByteString ptr repoPtr str' + createFromBuffer ptr repoPtr = + maybe (throw BlobCreateFailed) + (createBlobFromByteString ptr repoPtr) + =<< blobSourceToString (blobContents b) createBlobFromByteString ptr repoPtr bs = unsafeUseAsCStringLen bs $ diff --git a/Data/Git/Commit.hs b/Data/Git/Commit.hs --- a/Data/Git/Commit.hs +++ b/Data/Git/Commit.hs @@ -139,7 +139,7 @@ doWriteCommit :: Commit -> Maybe Text -> IO (Commit, COid) doWriteCommit c ref = do - coid <- withForeignPtr repo $ \repoPtr -> do + coid <- withForeignPtr (repoObj (gitRepo (commitInfo c))) $ \repoPtr -> do coid <- mallocForeignPtr withForeignPtr coid $ \coid' -> do conv <- U.open (commitEncoding c) (Just True) @@ -164,9 +164,6 @@ , COid coid) where - repo = fromMaybe (error "Repository invalid") - (repoObj (gitRepo (commitInfo c))) - withRef Nothing = flip ($) nullPtr withRef (Just name) = BS.useAsCString (E.encodeUtf8 name) diff --git a/Data/Git/Internal.hs b/Data/Git/Internal.hs --- a/Data/Git/Internal.hs +++ b/Data/Git/Internal.hs @@ -121,7 +121,7 @@ data Repository = Repository { repoPath :: FilePath , repoOnWriteRef :: [Reference -> IO ()] - , repoObj :: ObjPtr C'git_repository } + , repoObj :: ForeignPtr C'git_repository } instance Eq Repository where x == y = repoPath x == repoPath y && repoObj x == repoObj y @@ -155,7 +155,7 @@ , gitObj = obj } repositoryPtr :: Repository -> ForeignPtr C'git_repository -repositoryPtr repo = fromMaybe (error "Repository invalid") (repoObj repo) +repositoryPtr repo = repoObj repo openRepository :: FilePath -> IO Repository openRepository path = @@ -186,7 +186,7 @@ fptr <- newForeignPtr p'git_repository_free ptr' return Repository { repoPath = path , repoOnWriteRef = [] - , repoObj = Just fptr } + , repoObj = fptr } where doesNotExist = throwIO . RepositoryNotExist . toString @@ -217,14 +217,14 @@ case oid of Oid (COid oid') -> withForeignPtr oid' $ \oidPtr -> - lookupFn (castPtr ptr) repoPtr oidPtr + lookupFn ptr repoPtr oidPtr PartialOid (COid oid') len -> withForeignPtr oid' $ \oidPtr -> - lookupPrefixFn (castPtr ptr) repoPtr oidPtr (fromIntegral len) + lookupPrefixFn ptr repoPtr oidPtr (fromIntegral len) if r < 0 then return Nothing else do - ptr' <- peek ptr + ptr' <- castPtr <$> peek ptr coid <- c'git_object_id ptr' coidCopy <- mallocForeignPtr withForeignPtr coidCopy $ flip c'git_oid_cpy coid diff --git a/Data/Git/Reference.hs b/Data/Git/Reference.hs --- a/Data/Git/Reference.hs +++ b/Data/Git/Reference.hs @@ -66,7 +66,7 @@ writeRef :: Reference -> IO Reference writeRef ref = alloca $ \ptr -> do - withForeignPtr repo $ \repoPtr -> + withForeignPtr (repoObj (refRepo ref)) $ \repoPtr -> withCStringable (refName ref) $ \namePtr -> do r <- case refTarget ref of RefTargetId (PartialOid {}) -> @@ -88,9 +88,6 @@ mapM_ ($ ref') (repoOnWriteRef (refRepo ref')) return ref' - where - repo = fromMaybe (error "Repository invalid") (repoObj (refRepo ref)) - writeRef_ :: Reference -> IO () writeRef_ = void . writeRef @@ -100,13 +97,11 @@ resolveRef :: Repository -> Text -> IO (Maybe Oid) resolveRef repos name = alloca $ \ptr -> withCStringable name $ \namePtr -> - withForeignPtr repo $ \repoPtr -> do + withForeignPtr (repoObj repos) $ \repoPtr -> do r <- c'git_reference_name_to_oid ptr repoPtr namePtr if r < 0 then return Nothing else Just . Oid <$> COid <$> newForeignPtr_ ptr - where - repo = fromMaybe (error "Repository invalid") (repoObj repos) -- int git_reference_rename(git_reference *ref, const char *new_name, -- int force) diff --git a/Data/Git/Tree.hs b/Data/Git/Tree.hs --- a/Data/Git/Tree.hs +++ b/Data/Git/Tree.hs @@ -181,7 +181,7 @@ doWriteTree :: Tree -> IO (Tree, COid) doWriteTree t = alloca $ \ptr -> - withForeignPtr repo $ \repoPtr -> do + withForeignPtr (repoObj (gitRepo (treeInfo t))) $ \repoPtr -> do r <- c'git_treebuilder_create ptr nullPtr when (r < 0) $ throwIO TreeBuilderCreateFailed builder <- peek ptr @@ -219,9 +219,6 @@ , treeContents = M.fromList newList }, COid coid) where - repo = fromMaybe (error "Repository invalid") - (repoObj (gitRepo (treeInfo t))) - insertObject :: (CStringable a) => Ptr C'git_treebuilder -> a -> COid -> CUInt -> IO () insertObject builder key (COid coid) attrs = diff --git a/gitlib.cabal b/gitlib.cabal --- a/gitlib.cabal +++ b/gitlib.cabal @@ -1,5 +1,5 @@ Name: gitlib -Version: 0.6.4 +Version: 0.6.5 Synopsis: Higher-level types for working with hlibgit2 License-file: LICENSE License: MIT