gitlib-libgit2 1.0.2 → 1.1.0

raw patch · 3 files changed

+276/−255 lines, 3 filesdep ~gitlibdep ~gitlib-libgit2dep ~gitlib-testPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: gitlib, gitlib-libgit2, gitlib-test, gitlib-utils

API changes (from Hackage documentation)

Files

• Git/Libgit2.hs +270/−247
• Git/Libgit2/Types.hs +0/−2
• gitlib-libgit2.cabal +6/−6

@@ -5,6 +5,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}  {-# OPTIONS_GHC -fno-warn-name-shadowing                 -fno-warn-unused-binds@@ -20,7 +21,9 @@        , Commit()        , CommitOid()        , CommitRef()-       , Git.Oid(..)+       , Git.Oid+       , OidPtr(..)+       , mkOid        , Reference()        , Repository(..)        , Tree()@@ -96,68 +99,22 @@ debug :: MonadIO m => String -> m () --debug = liftIO . putStrLn debug = const (return ())--instance Git.MonadGit m => Git.Repository (LgRepository m) where-    data Oid (LgRepository m) = Oid-        { getOid :: ForeignPtr C'git_oid-        }-    data TreeData (LgRepository m) = TreeData-        { lgPendingUpdates :: IORef (HashMap Text (Tree m))-        , lgTreeContents   :: ForeignPtr C'git_treebuilder-        }--    data Options (LgRepository m) = Options--    facts = return Git.RepositoryFacts-        { Git.hasSymbolicReferences = True-        }--    parseOid        = lgParseOid-    renderOid       = lgRenderOid-    lookupRef       = lgLookupRef-    createRef       = lgUpdateRef-    updateRef       = lgUpdateRef-    deleteRef       = lgDeleteRef-    resolveRef      = lgResolveRef-    allRefNames     = lgAllRefNames-    lookupCommit    = lgLookupCommit 40-    lookupTree      = lgLookupTree 40-    lookupBlob      = lgLookupBlob-    lookupTag       = undefined-    lookupObject    = lgLookupObject-    existsObject    = lgExistsObject-    pushCommit      = \name _ rrefname -> Git.genericPushCommit name rrefname-    traverseCommits = lgTraverseCommits-    missingObjects  = lgMissingObjects-    traverseObjects = error "Not defined: LgRepository.traverseObjects"-    newTree         = lgNewTree-    hashContents    = lgHashContents-    createBlob      = lgWrap . lgCreateBlob-    createTag       = undefined--    createCommit p t a c l r = lgWrap $ lgCreateCommit p t a c l r--    deleteRepository = lgGet >>= liftIO . removeTree . repoPath++type Oid = OidPtr -    buildPackFile   = lgBuildPackFile-    buildPackIndex  = lgBuildPackIndexWrapper-    writePackFile   = lgWrap . lgWritePackFile+data OidPtr = OidPtr { getOid :: ForeignPtr C'git_oid } -    remoteFetch     = lgRemoteFetch+instance Git.IsOid OidPtr where+    renderOid = lgRenderOid -lgWrap :: (MonadIO m, MonadBaseControl IO m)-       => LgRepository m a -> LgRepository m a-lgWrap f = f `Exc.catch` \e -> do-    etrap <- lgExcTrap-    mexc  <- liftIO $ readIORef etrap-    liftIO $ writeIORef etrap Nothing-    maybe (throw (e :: SomeException)) throw mexc+mkOid :: ForeignPtr C'git_oid -> OidPtr+mkOid = OidPtr -lgParseOid :: Git.MonadGit m => Text -> LgRepository m (Oid m)+lgParseOid :: Git.MonadGit m => Text -> LgRepository m Oid lgParseOid str   | len > 40 = failure (Git.OidParseFailed str)   | otherwise = do-      oid <- liftIO mallocForeignPtr+      oid <- liftIO $ mallocForeignPtr       r <- liftIO $ withCString (T.unpack str) $ \cstr ->           withForeignPtr oid $ \ptr ->               if len == 40@@ -165,18 +122,18 @@                   else c'git_oid_fromstrn ptr cstr (fromIntegral len)       if r < 0           then failure (Git.OidParseFailed str)-          else return (Oid oid)+          else return (mkOid oid)   where     len = T.length str  lgRenderOid :: Git.Oid (LgRepository m) -> Text lgRenderOid = T.pack . show -instance Show (Git.Oid (LgRepository m)) where-    show (Oid coid) = SU.unsafePerformIO $ withForeignPtr coid oidToStr+instance Show OidPtr where+    show (getOid -> coid) = SU.unsafePerformIO $ withForeignPtr coid oidToStr -instance Ord (Git.Oid (LgRepository m)) where-    Oid coid1 `compare` Oid coid2 =+instance Ord OidPtr where+    (getOid -> coid1) `compare` (getOid -> coid2) =         SU.unsafePerformIO $         withForeignPtr coid1 $ \coid1Ptr ->         withForeignPtr coid2 $ \coid2Ptr -> do@@ -187,9 +144,68 @@                           then GT                           else EQ -instance Eq (Git.Oid (LgRepository m)) where+instance Eq OidPtr where     oid1 == oid2 = oid1 `compare` oid2 == EQ++data TreeBuilder m = TreeBuilder+    { lgPendingUpdates :: IORef (HashMap Text (Tree m))+    , lgTreeContents   :: ForeignPtr C'git_treebuilder+    } +instance Git.MonadGit m => Git.Repository (LgRepository m) where+    type Oid (LgRepository m)  = OidPtr+    type Tree (LgRepository m) = TreeBuilder m++    data Options (LgRepository m) = Options++    facts = return Git.RepositoryFacts+        { Git.hasSymbolicReferences = True+        }++    parseOid         = lgParseOid+    lookupRef        = lgLookupRef+    createRef        = lgUpdateRef+    updateRef        = lgUpdateRef+    deleteRef        = lgDeleteRef+    resolveRef       = lgResolveRef+    allRefNames      = lgAllRefNames+    lookupCommit     = lgLookupCommit 40+    lookupTree       = lgLookupTree 40+    lookupBlob       = lgLookupBlob+    lookupTag        = undefined+    lookupObject     = lgLookupObject+    existsObject     = lgExistsObject+    pushCommit       = \name _ rrefname -> Git.genericPushCommit name rrefname+    traverseCommits  = lgTraverseCommits+    missingObjects   = lgMissingObjects+    traverseObjects  = error "Not defined: LgRepository.traverseObjects"+    newTree          = lgNewTree+    cloneTree        = lgCloneTree+    traverseEntries  = lgTraverseEntries+    unsafeUpdateTree = lgModifyTree+    writeTree        = lgWriteTree+    hashContents     = lgHashContents+    createBlob       = lgWrap . lgCreateBlob+    createTag        = undefined++    createCommit p t a c l r = lgWrap $ lgCreateCommit p t a c l r++    deleteRepository = lgGet >>= liftIO . removeTree . repoPath++    buildPackFile   = lgBuildPackFile+    buildPackIndex  = lgBuildPackIndexWrapper+    writePackFile   = lgWrap . lgWritePackFile++    remoteFetch     = lgRemoteFetch++lgWrap :: (MonadIO m, MonadBaseControl IO m)+       => LgRepository m a -> LgRepository m a+lgWrap f = f `Exc.catch` \e -> do+    etrap <- lgExcTrap+    mexc  <- liftIO $ readIORef etrap+    liftIO $ writeIORef etrap Nothing+    maybe (throw (e :: SomeException)) throw mexc+ lgHashContents :: Git.MonadGit m => Git.BlobContents (LgRepository m)                -> LgRepository m (BlobOid m) lgHashContents b = do@@ -201,7 +217,7 @@                           c'git_odb_hash oidPtr (castPtr cstr)                                          (fromIntegral len) c'GIT_OBJ_BLOB)     when (r < 0) $ failure Git.BlobCreateFailed-    return (Tagged (Oid ptr))+    return (Tagged (mkOid ptr))  -- | Create a new blob in the 'Repository', with 'ByteString' as its contents. --@@ -216,7 +232,7 @@     r    <- Git.blobContentsToByteString b             >>= \bs -> liftIO $ createBlobFromByteString repo ptr bs     when (r < 0) $ failure Git.BlobCreateFailed-    return (Tagged (Oid ptr))+    return (Tagged (mkOid ptr))    where     createBlobFromByteString repo coid bs =@@ -246,43 +262,40 @@ type TreeEntry m = Git.TreeEntry (LgRepository m)  lgTraverseEntries :: Git.MonadGit m-                  => Tree m-                  -> (FilePath -> TreeEntry m -> LgRepository m a)+                  =>(FilePath -> TreeEntry m -> LgRepository m a)+                  -> Tree m                   -> LgRepository m [a]-lgTraverseEntries initialTree f = go "" initialTree-      where-        go fp tree = do-            entries <- liftIO $ withForeignPtr-                           (lgTreeContents (Git.getTreeData tree)) $ \tb -> do-                ior <- newIORef []-                bracket-                    (mk'git_treebuilder_filter_cb (callback fp ior))-                    freeHaskellFunPtr-                    (flip (c'git_treebuilder_filter tb) nullPtr)-                readIORef ior-            concat <$> mapM (uncurry handler) entries+lgTraverseEntries f initialTree = go "" initialTree+  where+    go fp tree = do+        entries <- liftIO $ withForeignPtr (lgTreeContents tree) $ \tb -> do+            ior <- newIORef []+            bracket+                (mk'git_treebuilder_filter_cb (callback fp ior))+                freeHaskellFunPtr+                (flip (c'git_treebuilder_filter tb) nullPtr)+            readIORef ior+        concat <$> mapM (uncurry handler) entries -        handler path entry@(Git.TreeEntry tref) = do-            x  <- f path entry-            xs <- Git.resolveTreeRef tref >>= go path-            return (x:xs)-        handler path entry = liftM2 (:) (f path entry) (return [])+    handler path entry@(Git.TreeEntry tref) = do+        x  <- f path entry+        xs <- Git.resolveTreeRef tref >>= go path+        return (x:xs)+    handler path entry = liftM2 (:) (f path entry) (return []) -        callback fp ior te _ = do-            cname <- c'git_tree_entry_name te-            name  <- (fp </>) . F.decodeString <$> peekCString cname-            entry <- entryToTreeEntry te-            modifyIORef ior $-                seq name $ seq entry (\xs -> (name,entry):xs)-            return 0+    callback fp ior te _ = do+        cname <- c'git_tree_entry_name te+        name  <- (fp </>) . F.decodeString <$> peekCString cname+        entry <- entryToTreeEntry te+        modifyIORef ior $+            seq name $ seq entry (\xs -> (name,entry):xs)+        return 0  lgMakeTree :: Git.MonadGit m            => IORef (HashMap Text (Tree m))            -> ForeignPtr C'git_treebuilder-           -> Tree m-lgMakeTree updates contents =-    Git.mkTree lgModifyTree lgWriteTree lgTraverseEntries $-        TreeData updates contents+           -> LgRepository m (Tree m)+lgMakeTree contents builder = return $ TreeBuilder contents builder  -- | Create a new, empty tree. --@@ -300,10 +313,41 @@      if r < 0         then failure (Git.TreeCreateFailed "Failed to create new tree builder")-        else lgMakeTree <$> liftIO (newIORef HashMap.empty)-                        <*> pure fptr+        else do+             contents <- liftIO (newIORef HashMap.empty)+             lgMakeTree contents fptr -lgLookupTree :: Git.MonadGit m => Int -> Tagged (Tree m) (Oid m)+lgCloneTree :: Git.MonadGit m => Tree m -> LgRepository m (Tree m)+lgCloneTree (TreeBuilder pending contents) =+    TreeBuilder <$> liftIO (newIORef =<< readIORef pending)+                <*> liftIO (copyBuilder contents)+  where+    copyBuilder fptr = withForeignPtr fptr $ \builder -> alloca $ \pptr -> do+        r <- c'git_treebuilder_create pptr nullPtr+        when (r < 0) $+            failure (Git.BackendError "Could not create new treebuilder")+        builder' <- peek pptr+        bracket+            (mk'git_treebuilder_filter_cb (callback builder'))+            freeHaskellFunPtr+            (flip (c'git_treebuilder_filter builder) nullPtr)+        FC.newForeignPtr builder'(c'git_treebuilder_free builder')++    callback builder te _ = do+        cname <- c'git_tree_entry_name te+        coid  <- c'git_tree_entry_id te+        fmode <- c'git_tree_entry_filemode te+        r <- c'git_treebuilder_insert+            nullPtr+            builder+            cname+            coid+            fmode+        when (r < 0) $+            failure (Git.BackendError "Could not insert entry in treebuilder")+        return 0++lgLookupTree :: Git.MonadGit m => Int -> Tagged (Tree m) Oid              -> LgRepository m (Tree m) lgLookupTree len oid = do     -- jww (2013-01-28): Verify the oid here@@ -323,7 +367,7 @@                       else do                       upds <- liftIO $ newIORef HashMap.empty                       return (upds,fptr)-    return $ lgMakeTree upds fptr+    lgMakeTree upds fptr  entryToTreeEntry :: Git.MonadGit m => Ptr C'git_tree_entry -> IO (TreeEntry m) entryToTreeEntry entry = do@@ -333,49 +377,18 @@     case () of         () | typ == c'GIT_OBJ_BLOB ->              do mode <- c'git_tree_entry_filemode entry-                return $ Git.BlobEntry (Tagged (Oid oid)) $+                return $ Git.BlobEntry (Tagged (mkOid oid)) $                     case mode of                         0o100644 -> Git.PlainBlob                         0o100755 -> Git.ExecutableBlob                         0o120000 -> Git.SymlinkBlob                         _        -> Git.UnknownBlob            | typ == c'GIT_OBJ_TREE ->-             return $ Git.TreeEntry (Git.ByOid (Tagged (Oid oid)))+             return $ Git.TreeEntry (Git.ByOid (Tagged (mkOid oid)))            | typ == c'GIT_OBJ_COMMIT ->-             return $ Git.CommitEntry (Tagged (Oid oid))+             return $ Git.CommitEntry (Tagged (mkOid oid))            | otherwise -> error "Unexpected" -doLookupTreeEntry :: Git.MonadGit m-                  => Tree m-                  -> [Text]-                  -> LgRepository m (Maybe (TreeEntry m))-doLookupTreeEntry t [] = return (Just (Git.treeEntry t))-doLookupTreeEntry t (name:names) = do-  -- Lookup the current name in this tree.  If it doesn't exist, and there are-  -- more names in the path and 'createIfNotExist' is True, create a new Tree-  -- and descend into it.  Otherwise, if it exists we'll have @Just (TreeEntry-  -- {})@, and if not we'll have Nothing.-  upds <- liftIO $ readIORef (lgPendingUpdates (Git.getTreeData t))-  y <- case HashMap.lookup name upds of-      Just m -> return . Just . Git.TreeEntry . Git.Known $ m-      Nothing ->-          liftIO $ withForeignPtr-              (lgTreeContents (Git.getTreeData t)) $ \builder -> do-                  entry <- withCString (T.unpack name)-                               (c'git_treebuilder_get builder)-                  if entry == nullPtr-                      then return Nothing-                      else Just <$> entryToTreeEntry entry-  if null names-      then return y-      else case y of-          Just (Git.BlobEntry {})   -> failure Git.TreeCannotTraverseBlob-          Just (Git.CommitEntry {}) -> failure Git.TreeCannotTraverseCommit-          Just (Git.TreeEntry t')   -> do-              t'' <- Git.resolveTreeRef t'-              doLookupTreeEntry t'' names-          _ -> return Nothing- -- | Write out a tree to its repository.  If it has already been written, --   nothing will happen. lgWriteTree :: Git.MonadGit m => Tree m -> LgRepository m (TreeOid m)@@ -384,16 +397,53 @@     emptyTreeOid <- Git.parseOid "4b825dc642cb6eb9a060e54bf8d69288fbee4904"     doWriteTree t         >>= return . Tagged . fromMaybe emptyTreeOid+  where+    doWriteTree tr = do+        repo <- lgGet+        let contents = lgTreeContents tr +        upds <- liftIO $ readIORef (lgPendingUpdates tr)+        forM_ (HashMap.toList upds) $ \(k,v) -> do+            oid <- doWriteTree v+            case oid of+                Nothing   -> dropEntry contents (T.unpack k)+                Just oid' -> insertEntry contents (T.unpack k) oid' 0o040000+        liftIO $ writeIORef (lgPendingUpdates tr) HashMap.empty++        cnt <- liftIO $ withForeignPtr contents c'git_treebuilder_entrycount+        if cnt == 0+            then return Nothing+            else go contents (repoObj repo)++    go :: Git.MonadGit m+       => ForeignPtr C'git_treebuilder+       -> ForeignPtr C'git_repository+       -> LgRepository m (Maybe Oid)+    go fptr repo = do+        (r3,coid) <- liftIO $ do+            coid <- mallocForeignPtr+            withForeignPtr coid $ \coid' ->+                withForeignPtr fptr $ \builder ->+                withForeignPtr repo $ \repoPtr -> do+                    r3 <- c'git_treebuilder_write coid' repoPtr builder+                    return (r3,coid)+        when (r3 < 0) $ do+            errPtr <- liftIO $ c'giterr_last+            err    <- liftIO $ peek errPtr+            errStr <- liftIO $ peekCString (c'git_error'message err)+            failure (Git.TreeBuilderWriteFailed $ T.pack $+                     "c'git_treebuilder_write failed with " ++ show r3+                     ++ ": " ++ errStr)+        return (Just (mkOid coid))+ lgTreeEntryCount :: Git.MonadGit m => Tree m -> LgRepository m Int lgTreeEntryCount t = do-    let tdata    = Git.getTreeData t-        contents = lgTreeContents tdata+    let contents = lgTreeContents t     fromIntegral         <$> liftIO (withForeignPtr contents c'git_treebuilder_entrycount)  insertEntry :: Git.MonadGit m-            => ForeignPtr C'git_treebuilder -> String -> Oid m -> CUInt+            => ForeignPtr C'git_treebuilder -> String -> Oid -> CUInt             -> LgRepository m () insertEntry builder key oid attrs = do   r2 <- liftIO $ withForeignPtr (getOid oid) $ \coid ->@@ -410,105 +460,61 @@           c'git_treebuilder_remove ptr name   when (r2 < 0) $ failure (Git.TreeBuilderRemoveFailed (T.pack key)) -doWriteTree :: Git.MonadGit m => Tree m -> LgRepository m (Maybe (Oid m))-doWriteTree t = do-    repo <- lgGet-    let tdata    = Git.getTreeData t-        contents = lgTreeContents tdata--    upds <- liftIO $ readIORef (lgPendingUpdates tdata)-    forM_ (HashMap.toList upds) $ \(k,v) -> do-        oid <- doWriteTree v-        case oid of-            Nothing   -> dropEntry contents (T.unpack k)-            Just oid' -> insertEntry contents (T.unpack k) oid' 0o040000-    liftIO $ writeIORef (lgPendingUpdates tdata) HashMap.empty--    cnt <- liftIO $ withForeignPtr contents c'git_treebuilder_entrycount-    if cnt == 0-        then return Nothing-        else go contents (repoObj repo)+lgModifyTree :: Git.MonadGit m+             => Tree m -> FilePath -> Bool+             -> (Maybe (TreeEntry m) -> Git.ModifyTreeResult (LgRepository m))+             -> LgRepository m (Tree m, Maybe (TreeEntry m))+lgModifyTree t path createIfNotExist f =+    fmap Git.fromModifyTreeResult+        <$> doModifyTree t (splitPath path) createIfNotExist   where-    go :: Git.MonadGit m-       => ForeignPtr C'git_treebuilder-       -> ForeignPtr C'git_repository-       -> LgRepository m (Maybe (Oid m))-    go fptr repo = do-        (r3,coid) <- liftIO $ do-            coid <- mallocForeignPtr-            withForeignPtr coid $ \coid' ->-                withForeignPtr fptr $ \builder ->-                withForeignPtr repo $ \repoPtr -> do-                    r3 <- c'git_treebuilder_write coid' repoPtr builder-                    return (r3,coid)-        when (r3 < 0) $ do-            errPtr <- liftIO $ c'giterr_last-            err    <- liftIO $ peek errPtr-            errStr <- liftIO $ peekCString (c'git_error'message err)-            failure (Git.TreeBuilderWriteFailed $ T.pack $-                     "c'git_treebuilder_write failed with " ++ show r3-                     ++ ": " ++ errStr)-        return (Just (Oid coid))--doModifyTree :: Git.MonadGit m-             => Tree m-             -> [Text]-             -> Bool-             -> (Maybe (TreeEntry m)-                 -> LgRepository m (Git.ModifyTreeResult (LgRepository m)))-             -> LgRepository m (Git.ModifyTreeResult (LgRepository m))-doModifyTree t [] _ _ =-    return . Git.TreeEntryPersistent . Git.TreeEntry . Git.Known $ t-doModifyTree t (name:names) createIfNotExist f = do     -- Lookup the current name in this tree.  If it doesn't exist, and there     -- are more names in the path and 'createIfNotExist' is True, create a new     -- Tree and descend into it.  Otherwise, if it exists we'll have @Just     -- (TreeEntry {})@, and if not we'll have Nothing.-    y' <- doLookupTreeEntry t [name]-    y  <- if isNothing y' && createIfNotExist && not (null names)-          then Just . Git.TreeEntry . Git.Known <$> Git.newTree-          else return y'+    doModifyTree tr [] _ =+        return (tr, Git.TreeEntryPersistent . Git.TreeEntry . Git.Known $ tr)+    doModifyTree tr (name:names) createIfNotExist = do+        y' <- doLookupTreeEntry tr [name]+        y  <- if isNothing y' && createIfNotExist && not (null names)+              then Just . Git.TreeEntry . Git.Known <$> Git.newTree+              else return y'+        go tr name names y -    if null names-        then do-        -- If there are no further names in the path, call the transformer-        -- function, f.  It receives a @Maybe TreeEntry@ to indicate if there-        -- was a previous entry at this path.  It should return a 'Left' value-        -- to propagate out a user-defined error, or a @Maybe TreeEntry@ to-        -- indicate whether the entry at this path should be deleted or-        -- replaced with something new.-        ---        -- NOTE: There is no provision for leaving the entry unchanged!  It is-        -- assumed to always be changed, as we have no reliable method of-        -- testing object equality that is not O(n).-        ze <- f y-        returnTree (Git.getTreeData t) (T.unpack name) ze+    -- If there are no further names in the path, call the transformer+    -- function, f.  It receives a @Maybe TreeEntry@ to indicate if there was+    -- a previous entry at this path.  It should return a 'Left' value to+    -- propagate out a user-defined error, or a @Maybe TreeEntry@ to indicate+    -- whether the entry at this path should be deleted or replaced with+    -- something new.+    --+    -- NOTE: There is no provision for leaving the entry unchanged!  It is+    -- assumed to always be changed, as we have no reliable method of testing+    -- object equality that is not O(n).+    go tr name [] y = returnTree tr (T.unpack name) (f y) -        else-          -- If there are further names in the path, descend them now.  If-          -- 'createIfNotExist' was False and there is no 'Tree' under the-          -- current name, or if we encountered a 'Blob' when a 'Tree' was-          -- required, throw an exception to avoid colliding with user-defined-          -- 'Left' values.-          case y of-              Nothing -> return Git.TreeEntryNotFound-              Just (Git.BlobEntry {})   -> failure Git.TreeCannotTraverseBlob-              Just (Git.CommitEntry {}) -> failure Git.TreeCannotTraverseCommit-              Just (Git.TreeEntry st')  -> do-                  st <- Git.resolveTreeRef st'-                  ze <- doModifyTree st names createIfNotExist f-                  case ze of-                      Git.TreeEntryNotFound     -> return ze-                      Git.TreeEntryPersistent _ -> return ze-                      Git.TreeEntryDeleted      -> postUpdate st ze-                      Git.TreeEntryMutated _    -> postUpdate st ze-  where-    postUpdate st ze = do-        liftIO $ modifyIORef-            (lgPendingUpdates (Git.getTreeData t))-            (HashMap.insert name st)-        return ze+    go tr _ _ Nothing                  = return (tr, Git.TreeEntryNotFound)+    go _ _ _ (Just Git.BlobEntry {})   = failure Git.TreeCannotTraverseBlob+    go _ _ _ (Just Git.CommitEntry {}) = failure Git.TreeCannotTraverseCommit +    -- If there are further names in the path, descend them now.  If+    -- 'createIfNotExist' was False and there is no 'Tree' under the current+    -- name, or if we encountered a 'Blob' when a 'Tree' was required, throw+    -- an exception to avoid colliding with user-defined 'Left' values.+    go tr name names (Just (Git.TreeEntry st')) = do+        st <- Git.resolveTreeRef st'+        (st'', ze) <- doModifyTree st names createIfNotExist+        case ze of+            Git.TreeEntryNotFound     -> return ()+            Git.TreeEntryPersistent _ -> return ()+            Git.TreeEntryDeleted      -> postUpdate tr st'' name+            Git.TreeEntryMutated _    -> postUpdate tr st'' name+        return (tr, ze)++    postUpdate tr st name =+        liftIO $ modifyIORef (lgPendingUpdates tr) $+            HashMap.insert name st+     returnTree tr n z = do         let contents = lgTreeContents tr         case z of@@ -518,7 +524,7 @@             Git.TreeEntryMutated z'   -> do                 (oid,mode) <- treeEntryToOid z'                 insertEntry contents n oid mode-        return z+        return (tr, z)      treeEntryToOid (Git.BlobEntry oid kind) =         return (unTagged oid,@@ -533,15 +539,31 @@         oid <- Git.treeRefOid tr         return (unTagged oid, 0o040000) -lgModifyTree-  :: Git.MonadGit m-  => Tree m -> FilePath -> Bool-     -> (Maybe (TreeEntry m)-         -> LgRepository m (Git.ModifyTreeResult (LgRepository m)))-     -> LgRepository m (Maybe (TreeEntry m))-lgModifyTree t path createIfNotExist f =-    Git.fromModifyTreeResult <$>-        doModifyTree t (splitPath path) createIfNotExist f+    -- Lookup the current name in this tree.  If it doesn't exist, and there+    -- are more names in the path and 'createIfNotExist' is True, create a new+    -- Tree and descend into it.  Otherwise, if it exists we'll have @Just+    -- (TreeEntry {})@, and if not we'll have Nothing.+    doLookupTreeEntry tr [] = return (Just (Git.treeEntry tr))+    doLookupTreeEntry tr (name:names) = do+      upds <- liftIO $ readIORef (lgPendingUpdates tr)+      y <- case HashMap.lookup name upds of+          Just m -> return . Just . Git.TreeEntry . Git.Known $ m+          Nothing ->+              liftIO $ withForeignPtr (lgTreeContents tr) $ \builder -> do+                  entry <- withCString (T.unpack name)+                               (c'git_treebuilder_get builder)+                  if entry == nullPtr+                      then return Nothing+                      else Just <$> entryToTreeEntry entry+      if null names+          then return y+          else case y of+              Just (Git.BlobEntry {})   -> failure Git.TreeCannotTraverseBlob+              Just (Git.CommitEntry {}) -> failure Git.TreeCannotTraverseCommit+              Just (Git.TreeEntry st)   -> do+                  st' <- Git.resolveTreeRef st+                  doLookupTreeEntry st' names+              _ -> return Nothing  splitPath :: FilePath -> [Text] splitPath path = T.splitOn "/" text@@ -574,14 +596,15 @@                      (replicate (fromIntegral (toInteger pn))                       (c'git_commit_parent_id c))                      [0..pn]-        poids' <- mapM (\x -> Git.ByOid . Tagged . Oid <$> coidPtrToOid x) poids+        poids' <- mapM (\x -> Git.ByOid . Tagged . mkOid+                                  <$> coidPtrToOid x) poids          return Git.Commit             {             -- Git.commitInfo      = Base (Just (Tagged (Oid coid))) (Just obj)             -- ,               Git.commitOid       = oid-            , Git.commitTree      = Git.ByOid (Tagged (Oid toid'))+            , Git.commitTree      = Git.ByOid (Tagged (mkOid toid'))             , Git.commitParents   = poids'             , Git.commitAuthor    = auth             , Git.commitCommitter = comm@@ -616,15 +639,15 @@     go coid _ y = do         typ <- liftIO $ c'git_object_type y         case () of-            () | typ == c'GIT_OBJ_BLOB   -> ret Git.BlobObj (Oid coid)-               | typ == c'GIT_OBJ_TREE   -> ret Git.TreeObj (Oid coid)-               | typ == c'GIT_OBJ_COMMIT -> ret Git.CommitObj (Oid coid)-               | typ == c'GIT_OBJ_TAG    -> ret Git.TagObj (Oid coid)+            () | typ == c'GIT_OBJ_BLOB   -> ret Git.BlobObj (mkOid coid)+               | typ == c'GIT_OBJ_TREE   -> ret Git.TreeObj (mkOid coid)+               | typ == c'GIT_OBJ_COMMIT -> ret Git.CommitObj (mkOid coid)+               | typ == c'GIT_OBJ_TAG    -> ret Git.TagObj (mkOid coid)                | otherwise -> failure (Git.ObjectLookupFailed str len)      ret f = return . f . Git.ByOid . Tagged -lgExistsObject :: Git.MonadGit m => Oid m -> LgRepository m Bool+lgExistsObject :: Git.MonadGit m => Oid -> LgRepository m Bool lgExistsObject oid = do     repo <- lgGet     result <- liftIO $ withForeignPtr (repoObj repo) $ \repoPtr ->@@ -675,7 +698,7 @@             (fromIntegral ((1 :: Int) .|. (4 :: Int)))         whileM ((==) <$> pure 0                      <*> c'git_revwalk_next coidPtr walker)-            (Git.ByOid . Tagged . Oid <$> coidPtrToOid coidPtr)+            (Git.ByOid . Tagged . mkOid <$> coidPtrToOid coidPtr)   where     pushOid oid =         withForeignPtr oid $ \coid -> do@@ -765,7 +788,7 @@         {         --   Git.commitInfo      = Base (Just (Tagged (Oid coid))) Nothing         -- ,-          Git.commitOid       = Tagged (Oid coid)+          Git.commitOid       = Tagged (mkOid coid)         , Git.commitTree      = tree         , Git.commitParents   = parents         , Git.commitAuthor    = author@@ -801,7 +824,7 @@             typ  <- c'git_reference_type ref             targ <- if typ == c'GIT_REF_OID                     then do oidPtr <- c'git_reference_target ref-                            Git.RefObj . Git.ByOid . Tagged . Oid+                            Git.RefObj . Git.ByOid . Tagged . mkOid                                 <$> coidPtrToOid oidPtr                     else do targName <- c'git_reference_symbolic_target ref                             Git.RefSymbolic . T.decodeUtf8@@ -855,7 +878,7 @@             if r < 0                 then return Nothing                 else Just <$> coidPtrToOid ptr-    return (Git.ByOid . Tagged . Oid <$> oid)+    return (Git.ByOid . Tagged . mkOid <$> oid)  -- int git_reference_rename(git_reference *ref, const char *new_name, --   int force)

@@ -88,8 +88,6 @@     liftBaseWith = defaultLiftBaseWith StMT     restoreM     = defaultRestoreM unStMT -type Oid m        = Git.Oid (LgRepository m)- type BlobOid m    = Git.BlobOid (LgRepository m) type TreeOid m    = Git.TreeOid (LgRepository m) type CommitOid m  = Git.CommitOid (LgRepository m)

@@ -1,5 +1,5 @@ Name:                gitlib-libgit2-Version:             1.0.2+Version:             1.1.0 Synopsis:            Libgit2 backend for gitlib License-file:        LICENSE License:             MIT@@ -23,9 +23,9 @@     Hs-source-dirs: test     Build-depends:            base >=3-        , gitlib-        , gitlib-test-        , gitlib-libgit2+        , gitlib             >= 1.1.0+        , gitlib-test        >= 1.1.0+        , gitlib-libgit2     >= 1.1.0         , HUnit              >= 1.2.5         , hspec              >= 1.4.4         , hspec-expectations >= 0.3@@ -36,8 +36,8 @@     ghc-options: -Wall     build-depends:           base                 >= 3 && < 5-        , gitlib-        , gitlib-utils+        , gitlib               >= 1.1.0+        , gitlib-utils         >= 1.1.0         , hlibgit2             >= 0.18.0.7         , attempt              >= 0.4.0         , bytestring           >= 0.9.2.1