diff --git a/Git/Libgit2.hs b/Git/Libgit2.hs --- a/Git/Libgit2.hs +++ b/Git/Libgit2.hs @@ -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 diff --git a/Git/Libgit2/Internal.hs b/Git/Libgit2/Internal.hs --- a/Git/Libgit2/Internal.hs +++ b/Git/Libgit2/Internal.hs @@ -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 diff --git a/Git/Libgit2/Types.hs b/Git/Libgit2/Types.hs --- a/Git/Libgit2/Types.hs +++ b/Git/Libgit2/Types.hs @@ -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 } diff --git a/gitlib-libgit2.cabal b/gitlib-libgit2.cabal --- a/gitlib-libgit2.cabal +++ b/gitlib-libgit2.cabal @@ -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 diff --git a/test/Smoke.hs b/test/Smoke.hs --- a/test/Smoke.hs +++ b/test/Smoke.hs @@ -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