gitlib-libgit2 2.0.2.1 → 2.1.0.0
raw patch · 5 files changed
+73/−100 lines, 5 filesdep +filepathdep +unixdep −data-defaultdep −system-fileiodep −system-filepathdep ~gitlibdep ~gitlib-libgit2dep ~gitlib-test
Dependencies added: filepath, unix
Dependencies removed: data-default, system-fileio, system-filepath
Dependency ranges changed: gitlib, gitlib-libgit2, gitlib-test, hlibgit2
Files
- Git/Libgit2.hs +53/−60
- Git/Libgit2/Internal.hs +10/−15
- Git/Libgit2/Types.hs +1/−15
- gitlib-libgit2.cabal +8/−9
- test/Smoke.hs +1/−1
Git/Libgit2.hs view
@@ -70,13 +70,10 @@ import Data.Maybe import Data.Monoid import Data.Tagged-import Data.Text (Text)+import Data.Text (Text, pack, unpack) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.ICU.Convert as U-import Filesystem hiding (removeFile)-import Filesystem.Path.CurrentOS (FilePath, (</>))-import qualified Filesystem.Path.CurrentOS as F import Foreign.C.String import Foreign.C.Types import qualified Foreign.Concurrent as FC@@ -91,10 +88,11 @@ import qualified Git import Git.Libgit2.Internal import Git.Libgit2.Types-import Prelude hiding (FilePath)-import System.Directory (removeFile)+import System.Directory+import System.FilePath.Posix import System.IO (openBinaryTempFile, hClose) import qualified System.IO.Unsafe as SU+import System.Posix.ByteString.FilePath import Unsafe.Coerce debug :: MonadIO m => String -> m ()@@ -114,7 +112,7 @@ lgParseOidIO :: Text -> Int -> IO (Maybe Oid) lgParseOidIO str len = do oid <- liftIO $ mallocForeignPtr- r <- liftIO $ withCString (T.unpack str) $ \cstr ->+ r <- liftIO $ withCString (unpack str) $ \cstr -> withForeignPtr oid $ \ptr -> if len == 40 then c'git_oid_fromstr ptr cstr@@ -135,7 +133,7 @@ len = T.length str lgRenderOid :: Git.Oid (LgRepository m) -> Text-lgRenderOid = T.pack . show+lgRenderOid = pack . show instance Show OidPtr where show (getOid -> coid) = SU.unsafePerformIO $ withForeignPtr coid oidToStr@@ -188,7 +186,7 @@ createCommit p t a c l r = lgWrap $ lgCreateCommit p t a c l r - deleteRepository = lgGet >>= liftIO . removeTree . repoPath+ deleteRepository = lgGet >>= liftIO . removeDirectoryRecursive . repoPath -- buildPackFile = lgBuildPackFile -- buildPackIndex = lgBuildPackIndexWrapper@@ -265,11 +263,11 @@ type TreeEntry m = Git.TreeEntry (LgRepository m) -lgTreeEntry :: Git.MonadGit m => Tree m -> Text+lgTreeEntry :: Git.MonadGit m => Tree m -> Git.TreeFilePath -> LgRepository m (Maybe (TreeEntry m)) lgTreeEntry (LgTree Nothing) _ = return Nothing lgTreeEntry (LgTree (Just tree)) fp = liftIO $ alloca $ \entryPtr ->- withCString (T.unpack fp) $ \pathStr ->+ withFilePath fp $ \pathStr -> withForeignPtr tree $ \treePtr -> do r <- c'git_tree_entry_bypath entryPtr treePtr pathStr if r < 0@@ -287,7 +285,7 @@ lgListTreeEntries :: Git.MonadGit m => Tree m- -> LgRepository m [(Text, TreeEntry m)]+ -> LgRepository m [(Git.TreeFilePath, TreeEntry m)] lgListTreeEntries (LgTree Nothing) = return [] lgListTreeEntries (LgTree (Just tree)) = do liftIO $ withForeignPtr tree $ \tr -> do@@ -301,9 +299,9 @@ where callback ior root te _ = do- fp <- peekCString root+ fp <- peekFilePath root cname <- c'git_tree_entry_name te- name <- T.pack . (fp <>) <$> peekCString cname+ name <- (fp <>) <$> peekFilePath cname entry <- entryToTreeEntry te seq name $ seq entry $ modifyIORef ior $ \xs -> (name,entry):xs return 0@@ -354,12 +352,12 @@ { Git.mtbBaseTreeOid = Git.treeOid <$> mtree } lgPutEntry :: Git.MonadGit m- => ForeignPtr C'git_treebuilder -> Text -> TreeEntry m+ => ForeignPtr C'git_treebuilder -> Git.TreeFilePath -> TreeEntry m -> LgRepository m () lgPutEntry builder key (treeEntryToOid -> (oid,mode)) = do r2 <- liftIO $ withForeignPtr (getOid oid) $ \coid -> withForeignPtr builder $ \ptr ->- withCString (T.unpack key) $ \name ->+ withFilePath key $ \name -> c'git_treebuilder_insert nullPtr ptr name coid (fromIntegral mode) when (r2 < 0) $ failure (Git.TreeBuilderInsertFailed key)@@ -377,18 +375,19 @@ (untag toid, 0o040000) lgDropEntry :: Git.MonadGit m- => ForeignPtr C'git_treebuilder -> Text -> LgRepository m ()+ => ForeignPtr C'git_treebuilder -> Git.TreeFilePath+ -> LgRepository m () lgDropEntry builder key = do void $ liftIO $ withForeignPtr builder $ \ptr ->- withCString (T.unpack key) $ c'git_treebuilder_remove ptr+ withFilePath key $ c'git_treebuilder_remove ptr lgLookupBuilderEntry :: Git.MonadGit m => ForeignPtr C'git_treebuilder- -> Text+ -> Git.TreeFilePath -> LgRepository m (Maybe (TreeEntry m)) lgLookupBuilderEntry builderPtr name = do- entry <- liftIO $ withForeignPtr builderPtr $ \builder -> do- withCString (T.unpack name) (c'git_treebuilder_get builder)+ entry <- liftIO $ withForeignPtr builderPtr $ \builder ->+ withFilePath name $ c'git_treebuilder_get builder if entry == nullPtr then return Nothing else Just <$> liftIO (entryToTreeEntry entry)@@ -420,7 +419,7 @@ errPtr <- c'giterr_last err <- peek errPtr peekCString (c'git_error'message err)- failure (Git.TreeBuilderWriteFailed $ T.pack $+ failure (Git.TreeBuilderWriteFailed $ pack $ "c'git_treebuilder_write failed with " ++ show r3 ++ ": " ++ errStr) return $ Tagged (mkOid coid)@@ -458,7 +457,7 @@ -> LgRepository m (Tree m) lgLookupTree len (getOid . untag -> oid) = do str <- liftIO $ withForeignPtr oid $ \oidPtr -> oidToStr oidPtr- if str == T.unpack Git.emptyTreeId+ if str == unpack Git.emptyTreeId then return (LgTree Nothing) else do -- jww (2013-01-28): Verify the oid here@@ -545,7 +544,7 @@ mfptr <- liftIO $ do fptr <- mallocForeignPtr withForeignPtr fptr $ \ptr ->- withCString (T.unpack str) $ \cstr -> do+ withCString (unpack str) $ \cstr -> do r <- if len == 40 then c'git_oid_fromstr ptr cstr else c'git_oid_fromstrn ptr cstr (fromIntegral len)@@ -660,8 +659,8 @@ -> TreeOid m -> Git.Signature -> Git.Signature- -> Text- -> Maybe Text+ -> Git.CommitMessage+ -> Maybe Git.RefName -> LgRepository m (Commit m) lgCreateCommit pptrs tree author committer logText ref = do repo <- lgGet@@ -711,12 +710,13 @@ mapM_ touchForeignPtr fos return r -lgLookupRef :: Git.MonadGit m => Text -> LgRepository m (Maybe (RefTarget m))+lgLookupRef :: Git.MonadGit m+ => Git.RefName -> LgRepository m (Maybe (RefTarget m)) lgLookupRef name = do repo <- lgGet liftIO $ alloca $ \ptr -> do r <- withForeignPtr (repoObj repo) $ \repoPtr ->- withCString (T.unpack name) $ \namePtr ->+ withCString (unpack name) $ \namePtr -> c'git_reference_lookup ptr repoPtr namePtr if r < 0 then return Nothing@@ -734,13 +734,13 @@ return (Just targ) lgUpdateRef :: Git.MonadGit m- => Text -> Git.RefTarget (LgRepository m)+ => Git.RefName -> Git.RefTarget (LgRepository m) -> LgRepository m () lgUpdateRef name refTarg = do repo <- lgGet r <- liftIO $ alloca $ \ptr -> withForeignPtr (repoObj repo) $ \repoPtr ->- withCString (T.unpack name) $ \namePtr -> do+ withCString (unpack name) $ \namePtr -> do case refTarg of Git.RefObj oid -> withForeignPtr (getOid (untag oid)) $ \coidPtr ->@@ -748,7 +748,7 @@ coidPtr (fromBool True) Git.RefSymbolic symName ->- withCString (T.unpack symName) $ \symPtr ->+ withCString (unpack symName) $ \symPtr -> c'git_reference_symbolic_create ptr repoPtr namePtr symPtr (fromBool True) when (r < 0) $ do@@ -757,16 +757,17 @@ err <- peek errPtr peekCString (c'git_error'message err) failure (Git.ReferenceCreateFailed $ name <> " => "- <> T.pack (show refTarg) <> ": " <> T.pack errStr)+ <> pack (show refTarg) <> ": " <> pack errStr) -- int git_reference_name_to_oid(git_oid *out, git_repository *repo, -- const char *name) -lgResolveRef :: Git.MonadGit m => Text -> LgRepository m (Maybe (CommitOid m))+lgResolveRef :: Git.MonadGit m+ => Git.RefName -> LgRepository m (Maybe (CommitOid m)) lgResolveRef name = do repo <- lgGet oid <- liftIO $ alloca $ \ptr ->- withCString (T.unpack name) $ \namePtr ->+ withCString (unpack name) $ \namePtr -> withForeignPtr (repoObj repo) $ \repoPtr -> do r <- c'git_reference_name_to_id ptr repoPtr namePtr if r < 0@@ -779,11 +780,11 @@ --renameRef = c'git_reference_rename -lgDeleteRef :: Git.MonadGit m => Text -> LgRepository m ()+lgDeleteRef :: Git.MonadGit m => Git.RefName -> LgRepository m () lgDeleteRef name = do repo <- lgGet r <- liftIO $ alloca $ \ptr ->- withCString (T.unpack name) $ \namePtr ->+ withCString (unpack name) $ \namePtr -> withForeignPtr (repoObj repo) $ \repoPtr -> do r <- c'git_reference_lookup ptr repoPtr namePtr if r < 0@@ -839,7 +840,7 @@ r0 <- Foreign.Marshal.Array.peekArray count strings r1 <- sequence $ fmap peekCString r0- return $ fmap T.pack r1+ return $ fmap pack r1 flagsToInt :: ListFlags -> CUInt flagsToInt flags = (if listFlagOid flags then 1 else 0)@@ -847,8 +848,7 @@ + (if listFlagPacked flags then 4 else 0) + (if listFlagHasPeel flags then 8 else 0) -listRefNames :: Git.MonadGit m- => ListFlags -> LgRepository m [Text]+listRefNames :: Git.MonadGit m => ListFlags -> LgRepository m [Git.RefName] listRefNames flags = do repo <- lgGet refs <- liftIO $ alloca $ \c'refs ->@@ -861,15 +861,14 @@ return (Just refs) maybe (failure Git.ReferenceListingFailed) return refs -lgListRefs :: Git.MonadGit m- => LgRepository m [Text]+lgListRefs :: Git.MonadGit m => LgRepository m [Git.RefName] lgListRefs = listRefNames allRefsFlag -- foreachRefCallback :: CString -> Ptr () -> IO CInt -- foreachRefCallback name payload = do -- (callback,results) <- deRefStablePtr =<< peek (castPtr payload) -- nameStr <- peekCString name--- result <- callback (T.pack nameStr)+-- result <- callback (pack nameStr) -- modifyIORef results (\xs -> result:xs) -- return 0 @@ -923,10 +922,10 @@ lgBuildPackFile dir oids = do repo <- lgGet liftIO $ do- (filePath, fHandle) <- openBinaryTempFile (pathStr dir) "pack"+ (filePath, fHandle) <- openBinaryTempFile dir "pack" hClose fHandle go repo filePath- return . F.fromText . T.pack $ filePath+ return filePath where go repo path = runResourceT $ do delKey <- register $ removeFile path@@ -974,18 +973,17 @@ -> LgRepository m (Text, FilePath, FilePath) lgBuildPackIndexWrapper = (liftIO .) . lgBuildPackIndex -lgBuildPackIndex :: FilePath -> B.ByteString- -> IO (Text, FilePath, FilePath)+lgBuildPackIndex :: FilePath -> B.ByteString -> IO (Text, FilePath, FilePath) lgBuildPackIndex dir bytes = do sha <- go dir bytes (,,) <$> pure sha- <*> pure (dir </> F.fromText ("pack-" <> sha <> ".pack"))- <*> pure (dir </> F.fromText ("pack-" <> sha <> ".idx"))+ <*> pure (dir </> ("pack-" <> unpack sha <> ".pack"))+ <*> pure (dir </> ("pack-" <> unpack sha <> ".idx")) where go dir bytes = alloca $ \idxPtrPtr -> runResourceT $ do debug "Allocate a new indexer stream" (_,idxPtr) <- flip allocate c'git_indexer_stream_free $- withCString (pathStr dir) $ \dirStr -> do+ withCString dir $ \dirStr -> do r <- c'git_indexer_stream_new idxPtrPtr dirStr nullFunPtr nullPtr checkResult r "c'git_indexer_stream_new failed"@@ -1073,7 +1071,7 @@ (c'git_odb_writepack'free writepack) writepackPtr) writepack <- liftIO $ peek writepackPtr - bs <- liftIO $ B.readFile (pathStr packFile)+ bs <- liftIO $ B.readFile packFile debug $ "Writing pack file " ++ show packFile ++ " into odb" debug $ "Writing " ++ show (B.length bs) ++ " pack bytes into odb" liftIO $ BU.unsafeUseAsCStringLen bs $@@ -1103,7 +1101,7 @@ debug $ "Load pack index " ++ show idxPath ++ " into temporary odb" (_,backendPtr) <- allocate- (do r <- withCString (pathStr idxPath) $ \idxPathStr ->+ (do r <- withCString idxPath $ \idxPathStr -> c'git_odb_backend_one_pack backendPtrPtr idxPathStr checkResult r "c'git_odb_backend_one_pack failed" peek backendPtrPtr)@@ -1176,8 +1174,8 @@ lgRemoteFetch uri fetchSpec = do xferRepo <- lgGet liftIO $ withForeignPtr (repoObj xferRepo) $ \repoPtr ->- withCString (T.unpack uri) $ \uriStr ->- withCString (T.unpack fetchSpec) $ \fetchStr ->+ withCString (unpack uri) $ \uriStr ->+ withCString (unpack fetchSpec) $ \fetchStr -> alloca $ runResourceT . go repoPtr uriStr fetchStr where go repoPtr uriStr fetchStr remotePtrPtr = do@@ -1206,15 +1204,10 @@ , Git.shutdownBackend = shutdownLgBackend } -withFilePath :: FilePath -> (CString -> IO a) -> IO a-withFilePath fp f = case F.toText fp of- Left _ -> error $ "Could not translate path: " ++ show fp- Right p -> withCString (T.unpack p) f- openLgRepository :: Git.MonadGit m => Git.RepositoryOptions -> m Repository openLgRepository opts = do let path = Git.repoPath opts- p <- liftIO $ isDirectory path+ p <- liftIO $ doesDirectoryExist path liftIO $ openRepositoryWith path $ if not (Git.repoAutoCreate opts) || p then c'git_repository_open@@ -1223,7 +1216,7 @@ where openRepositoryWith path fn = do fptr <- alloca $ \ptr ->- withFilePath path $ \str -> do+ withCString path $ \str -> do r <- fn ptr str when (r < 0) $ error $ "Could not open repository " ++ show path
Git/Libgit2/Internal.hs view
@@ -18,8 +18,6 @@ import Data.Time import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)-import Filesystem.Path.CurrentOS ((</>))-import qualified Filesystem.Path.CurrentOS as F import Foreign.C.String import Foreign.C.Types import Foreign.ForeignPtr@@ -30,7 +28,7 @@ import Git.Libgit2.Backend import Git.Libgit2.Trace import Git.Libgit2.Types-import Prelude hiding (FilePath)+import System.FilePath.Posix type ObjPtr a = Maybe (ForeignPtr a) @@ -42,19 +40,16 @@ addTracingBackend :: Git.MonadGit m => LgRepository m () addTracingBackend = do repo <- lgGet- case F.toText (repoPath repo </> "objects") of- Left p -> error $ "Object directory does not exist: " ++ T.unpack p- Right p ->- liftIO $ withCString (T.unpack p) $ \objectsDir ->- alloca $ \loosePtr -> do- r <- c'git_odb_backend_loose loosePtr objectsDir (-1) 0- when (r < 0) $- error "Failed to create loose objects backend"+ liftIO $ withCString (repoPath repo </> "objects") $ \objectsDir ->+ alloca $ \loosePtr -> do+ r <- c'git_odb_backend_loose loosePtr objectsDir (-1) 0+ when (r < 0) $+ error "Failed to create loose objects backend" - loosePtr' <- peek loosePtr- backend <- traceBackend loosePtr'- void $ odbBackendAdd repo backend 3- return ()+ loosePtr' <- peek loosePtr+ backend <- traceBackend loosePtr'+ void $ odbBackendAdd repo backend 3+ return () coidPtrToOid :: Ptr C'git_oid -> IO (ForeignPtr C'git_oid) coidPtrToOid coidptr = do
Git/Libgit2/Types.hs view
@@ -21,12 +21,8 @@ import Data.Conduit import Data.IORef import Data.Monoid-import Data.Text (Text)-import Data.Text as T (pack, unpack)-import Filesystem.Path.CurrentOS (FilePath, toText) import Foreign.ForeignPtr import qualified Git-import Prelude hiding (FilePath) import System.IO.Unsafe data Repository = Repository@@ -41,18 +37,8 @@ instance Eq Repository where x == y = repoPath x == repoPath y && repoObj x == repoObj y -pathText :: FilePath -> Text-pathText = go . toText- where- go (Left e) =- throw . Git.BackendError $ "Could not render path: " <> T.pack (show e)- go (Right p) = p--pathStr :: FilePath -> String-pathStr = T.unpack . pathText- instance Show Repository where- show x = "Repository " <> pathStr (repoPath x)+ show x = "Repository " <> repoPath x newtype LgRepository m a = LgRepository { lgRepositoryReaderT :: ReaderT Repository m a }
gitlib-libgit2.cabal view
@@ -1,5 +1,5 @@ Name: gitlib-libgit2-Version: 2.0.2.1+Version: 2.1.0.0 Synopsis: Libgit2 backend for gitlib License-file: LICENSE License: MIT@@ -23,9 +23,9 @@ Hs-source-dirs: test Build-depends: base >=3- , gitlib >= 2.0.1.0- , gitlib-test >= 2.0.0.0- , gitlib-libgit2 >= 2.0.2.1+ , gitlib >= 2.1.0.0+ , gitlib-test >= 2.1.0.0+ , gitlib-libgit2 >= 2.1.0.0 , HUnit >= 1.2.5 , hspec >= 1.4.4 , hspec-expectations >= 0.3@@ -36,17 +36,17 @@ ghc-options: -Wall build-depends: base >= 3 && < 5- , gitlib >= 2.0.1.0- , hlibgit2 >= 0.18.0.9+ , gitlib >= 2.1.0.0+ , hlibgit2 >= 0.18.0.10 , attempt >= 0.4.0 , binary >= 0.5.1.0 , bytestring >= 0.9.2.1 , base16-bytestring >= 0.1.1.5 , conduit >= 0.5.5 , containers >= 0.4.2- , data-default >= 0.5.0 , directory >= 1.1.0.2 , failure >= 0.2.0.1+ , filepath >= 1.3.0 , hashable >= 1.1.2.5 , hex >= 0.1.2 , lifted-base >= 0.2.0.2@@ -56,8 +56,6 @@ , parallel-io >= 0.3.2.1 , pointless-fun >= 1.1.0.1 , resourcet >= 0.4.6- , system-fileio >= 0.3.9- , system-filepath >= 0.4.7 , tagged >= 0.2.3.1 , text >= 0.11.2 , text-icu >= 0.6.3@@ -65,6 +63,7 @@ , time >= 1.4 , transformers >= 0.3.0.0 , transformers-base >= 0.4.1+ , unix >= 2.5 , unordered-containers >= 0.2.3 exposed-modules: Git.Libgit2
test/Smoke.hs view
@@ -9,7 +9,7 @@ module Main where import Control.Exception (finally)-import qualified Git as Git+import qualified Git import qualified Git.Smoke as Git import qualified Git.Libgit2 as Lg import Test.Hspec.Runner