gitlib 0.4.0 → 0.4.1

raw patch · 7 files changed

+73/−16 lines, 7 filesdep ~directory

Dependency ranges changed: directory

Files

• Data/Git/Commit.hs +16/−11
• Data/Git/Errors.hs +1/−0
• Data/Git/Internal.hs +17/−0
• Data/Git/Oid.hs +1/−0
• Data/Git/Repository.hs +6/−1
• Data/Git/Tree.hs +30/−2
• gitlib.cabal +2/−2

@@ -99,17 +99,6 @@                       , _commitEncoding  = encs                       , _commitObj       = Just $ unsafeCoerce obj } -withGitCommit :: Updatable b-              => ObjRef Commit -> b -> (Ptr C'git_commit -> IO a) -> IO a-withGitCommit cref obj f = do-  c' <- loadObject cref obj-  case c' of-    Nothing -> error "Cannot find Git commit in repository"-    Just co ->-      case co^.commitInfo.gitObj of-        Nothing  -> error "Cannot find Git commit id"-        Just co' -> withForeignPtr co' (f . castPtr)- -- | Write out a commit to its repository.  If it has already been written, --   nothing will happen. writeCommit :: Maybe Text -> Commit -> IO Commit@@ -182,6 +171,22 @@               when (r < 0) $ throwIO CommitLookupFailed               ptr' <- peek ptr               FC.newForeignPtr ptr' (c'git_commit_free ptr')++modifyCommitTree+  :: FilePath -> (Maybe TreeEntry -> Either a (Maybe TreeEntry)) -> Bool+  -> Commit -> IO (Either a Commit)+modifyCommitTree path f createIfNotExist c =+  withObject (c^.commitTree) c $ \tr -> do+    result <- modifyTree path f createIfNotExist tr+    case result of+      Left x    -> return (Left x)+      Right tr' -> return $ Right $ commitTree .~ ObjRef tr' $ c++removeFromCommitTree :: FilePath -> Commit -> IO Commit+removeFromCommitTree path c =+  withObject (c^.commitTree) c $ \tr -> do+    tr' <- removeFromTree path tr+    return $ commitTree .~ ObjRef tr' $ c  doUpdateCommit :: [Text] -> TreeEntry -> Commit -> IO Commit doUpdateCommit xs item c = do

@@ -21,6 +21,7 @@                   | TreeBuilderWriteFailed                   | TreeLookupFailed                   | TreeCannotTraverseBlob+                  | TreeEntryLookupFailed                   | CommitCreateFailed                   | CommitLookupFailed                   | ReferenceCreateFailed

@@ -21,6 +21,8 @@        , repositoryPtr         , lookupObject'+       , withObject+       , withObjectPtr         , module X )        where@@ -156,6 +158,21 @@                           , _repoObj  = Just fptr }    where doesNotExist = throwIO . RepositoryNotExist . toString++withObject :: (Updatable a, Updatable b) => ObjRef a -> b -> (a -> IO c) -> IO c+withObject objRef parent f = do+  obj <- loadObject objRef parent+  case obj of+    Nothing   -> error "Cannot find Git object in repository"+    Just obj' -> f obj'++withObjectPtr :: (Updatable a, Updatable b)+              => ObjRef a -> b -> (Ptr c -> IO d) -> IO d+withObjectPtr objRef parent f =+  withObject objRef parent $ \obj ->+    case objectPtr obj of+      Nothing     -> error "Cannot find Git object id"+      Just objPtr -> withForeignPtr objPtr (f . castPtr)  lookupObject'   :: Oid -> Repository

@@ -42,6 +42,7 @@ --   loadObject from the type class 'Updatable'. data ObjRef a = IdRef COid               | ObjRef a+              deriving Show  wrapOidPtr :: Ptr C'git_oid -> IO (ObjRef a) wrapOidPtr = newForeignPtr_ >=> return . IdRef . COid

@@ -15,7 +15,12 @@         , openRepository        , createRepository-       , openOrCreateRepository )+       , openOrCreateRepository++       , lookupObject'+       , withObject+       , withObjectPtr+       )        where  import Data.Git.Internal

@@ -89,6 +89,34 @@                        newBase repo (Stored coid) (Just obj)                   , _treeContents = M.empty } +doLookupTreeEntry :: [Text] -> Tree -> IO (Maybe TreeEntry)+doLookupTreeEntry [] _ = throw TreeEntryLookupFailed+doLookupTreeEntry (name:names) t = 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 <- case M.lookup name (t^.treeContents) of+    Nothing -> return Nothing+    Just j  -> case j of+      BlobEntry b mode -> do+        bl <- loadObject b t+        for bl $ \x -> return $ BlobEntry (ObjRef x) mode+      TreeEntry t' -> do+        tr <- loadObject t' t+        for tr $ \x -> return $ TreeEntry (ObjRef x)++  if null names+    then return y+    else+      case y of+        Just (BlobEntry {}) -> throw TreeCannotTraverseBlob+        Just (TreeEntry (ObjRef t')) -> doLookupTreeEntry names t'+        _ -> throw TreeEntryLookupFailed++lookupTreeEntry :: FilePath -> Tree -> IO (Maybe TreeEntry)+lookupTreeEntry = doLookupTreeEntry . splitPath+ withGitTree :: Updatable b             => ObjRef Tree -> b -> (Ptr C'git_tree -> IO a) -> IO a withGitTree tref obj f =@@ -150,7 +178,7 @@     repo = fromMaybe (error "Repository invalid") $                      t^.treeInfo.gitRepo.repoObj -    insertObject :: (CStringable a, Updatable b)+    insertObject :: (CStringable a, Updatable b, Show b)                  => Ptr C'git_treebuilder -> a -> ObjRef b -> CUInt                  -> IO (ObjRef b)     insertObject builder key obj attrs = do@@ -160,7 +188,7 @@           oid <- objectId x           case oid of             Oid (COid y) -> return y-            _ -> error "Unexpected"+            _ -> error $ "Failed to determine object id for: " ++ show x        withForeignPtr coid $ \coid' ->         withCStringable key $ \name -> do

@@ -1,5 +1,5 @@ Name:                gitlib-Version:             0.4.0+Version:             0.4.1 Synopsis:            Higher-level types for working with hlibgit2 Description:         Higher-level types for working with hlibgit2 License-file:        LICENSE@@ -38,7 +38,7 @@   main-is: doctests.hs   build-depends:       base == 4.*-    , directory >= 1.0 && < 1.2+    , directory >= 1.0 && < 1.3     , doctest   >= 0.8 && <= 0.10     , filepath  >= 1.3 && < 1.4   ghc-options: -Wall -Werror