gitlib-libgit2 2.2.0.0 → 2.2.0.1

raw patch · 2 files changed

+38/−32 lines, 2 files

Files

• Git/Libgit2.hs +37/−31
• gitlib-libgit2.cabal +1/−1

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}@@ -190,7 +191,7 @@     createReference   = lgUpdateRef     updateReference   = lgUpdateRef     deleteReference   = lgDeleteRef-    listReferences    = lgListRefs+    sourceReferences  = lgSourceRefs     lookupCommit      = lgLookupCommit     lookupTree        = lgLookupTree     lookupBlob        = lgLookupBlob@@ -201,7 +202,7 @@     newTreeBuilder    = lgNewTreeBuilder     treeEntry         = lgTreeEntry     treeOid           = lgTreeOid-    listTreeEntries   = lgListTreeEntries+    sourceTreeEntries = lgSourceTreeEntries     hashContents      = lgHashContents     createBlob        = lgWrap . lgCreateBlob     createTag         = error "Not implemented: LgRepository.createTag"@@ -330,27 +331,27 @@     ftoid <- coidPtrToOid toid     return $ Tagged (mkOid ftoid) -lgListTreeEntries :: MonadLg m-                  => Tree m-                  -> LgRepository m [(Git.TreeFilePath, TreeEntry m)]-lgListTreeEntries (LgTree Nothing) = return []-lgListTreeEntries (LgTree (Just tree)) =+lgSourceTreeEntries+    :: MonadLg m+    => Tree m+    -> Producer (LgRepository m) (Git.TreeFilePath, TreeEntry m)+lgSourceTreeEntries (LgTree Nothing) = return ()+lgSourceTreeEntries (LgTree (Just tree)) = gatherFrom 16 $ \queue -> do     liftIO $ withForeignPtr tree $ \tr -> do-        ior <- newIORef []         r <- bracket-                (mk'git_treewalk_cb (callback ior))+                (mk'git_treewalk_cb (callback queue))                 freeHaskellFunPtr-                (flip (c'git_tree_walk tr c'GIT_TREEWALK_PRE) nullPtr)-        when (r < 0) $ failure Git.TreeWalkFailed-        readIORef ior-+                (\callback ->+                  c'git_tree_walk tr c'GIT_TREEWALK_PRE callback nullPtr)+        when (r < 0) $ lgThrow Git.TreeWalkFailed   where-    callback ior root te _ = do+    callback queue root te _payload = do         fp    <- peekFilePath root         cname <- c'git_tree_entry_name te         name  <- (fp <>) <$> peekFilePath cname         entry <- entryToTreeEntry te-        seq name $ seq entry $ modifyIORef ior $ \xs -> (name,entry):xs+        atomically $+            writeTBQueue queue $ name `seq` entry `seq` (name,entry)         return 0  lgMakeBuilder :: MonadLg m@@ -863,21 +864,26 @@                  + (if listFlagPacked flags   then 4 else 0)                  + (if listFlagHasPeel flags  then 8 else 0) -listRefNames :: MonadLg m => ListFlags -> LgRepository m [Git.RefName]-listRefNames flags = do-    repo <- lgGet-    refs <- liftIO $ alloca $ \c'refs ->-      withForeignPtr (repoObj repo) $ \repoPtr -> do-        r <- c'git_reference_list c'refs repoPtr (flagsToInt flags)-        if r < 0-            then return Nothing-            else do refs <- gitStrArray2List c'refs-                    c'git_strarray_free c'refs-                    return (Just refs)-    maybe (failure Git.ReferenceListingFailed) return refs--lgListRefs :: MonadLg m => LgRepository m [Git.RefName]-lgListRefs = listRefNames allRefsFlag+lgSourceRefs :: MonadLg m => Producer (LgRepository m) Git.RefName+lgSourceRefs =+    gatherFrom 16 $ \queue -> do+        repo <- lgGet+        r <- liftIO $ bracket+            (mk'git_reference_foreach_cb (callback queue))+            freeHaskellFunPtr+            (\callback -> withForeignPtr (repoObj repo) $ \repoPtr ->+                  c'git_reference_foreach repoPtr+                      (flagsToInt allRefsFlag) callback nullPtr)+        when (r < 0) $ lgThrow Git.ReferenceListingFailed+  where+    callback :: TBQueue Text+             -> CString+             -> Ptr ()+             -> IO CInt+    callback queue cname _payload = do+        name <- peekCString cname+        atomically $ writeTBQueue queue (pack name)+        return 0  -- foreachRefCallback :: CString -> Ptr () -> IO CInt -- foreachRefCallback name payload = do@@ -1003,7 +1009,7 @@     gatherFrom 16 $ generateDiff repo   where     generateDiff repo chan = do-        entries   <- M.fromList <$> lgListTreeEntries tree+        entries   <- M.fromList <$> Git.listTreeEntries tree         paths     <- liftIO $ newIORef []         (src, ()) <- lift $ contents $$+ return () 

@@ -1,5 +1,5 @@ Name:                gitlib-libgit2-Version:             2.2.0.0+Version:             2.2.0.1 Synopsis:            Libgit2 backend for gitlib License-file:        LICENSE License:             MIT