gitlib 0.5.5 → 0.6.4

raw patch · 11 files changed

+315/−235 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Git/Blob.hs +16/−6
• Data/Git/Commit.hs +88/−61
• Data/Git/Error.hs +1/−0
• Data/Git/Internal.hs +10/−5
• Data/Git/Object.hs +14/−8
• Data/Git/Oid.hs +12/−7
• Data/Git/Reference.hs +12/−92
• Data/Git/Tree.hs +15/−15
• Data/Git/Tutorial.hs +65/−1
• gitlib.cabal +10/−2
• test/Smoke.hs +72/−38

@@ -28,6 +28,12 @@                   | BlobString B.ByteString                   | BlobStream ByteSource +instance Eq BlobContents where+  BlobEmpty == BlobEmpty = True+  BlobString str1 == BlobString str2 = str1 == str2+  BlobStream src1 == BlobStream src2 = False+  _ == _ = False+ blobSourceToString :: BlobContents -> IO (Maybe B.ByteString) blobSourceToString BlobEmpty = return Nothing blobSourceToString (BlobString bs) = return (Just bs)@@ -38,6 +44,7 @@  data Blob = Blob { blobInfo     :: Base Blob                  , blobContents :: BlobContents }+          deriving Eq  instance Show Blob where   show x = case gitId (blobInfo x) of@@ -62,16 +69,16 @@ -- --   Note that since empty blobs cannot exist in Git, no means is provided for --   creating one; if the give string is 'empty', it is an error.-createBlob :: B.ByteString -> Repository -> Blob-createBlob text repo+createBlob :: Repository -> B.ByteString -> Blob+createBlob repo text   | text == B.empty = error "Cannot create an empty blob"   | otherwise =     Blob { blobInfo     = newBase repo (Pending doWriteBlob) Nothing          , blobContents = BlobString text } -lookupBlob :: Oid -> Repository -> IO (Maybe Blob)-lookupBlob oid repo =-  lookupObject' oid repo c'git_blob_lookup c'git_blob_lookup_prefix $+lookupBlob :: Repository -> Oid -> IO (Maybe Blob)+lookupBlob repo oid =+  lookupObject' repo oid c'git_blob_lookup c'git_blob_lookup_prefix $     \coid obj _ ->       return Blob { blobInfo     = newBase repo (Stored coid) (Just obj)                   , blobContents = BlobEmpty }@@ -85,13 +92,16 @@         withForeignPtr blobPtr $ \ptr -> do           size <- c'git_blob_rawsize (castPtr ptr)           buf  <- c'git_blob_rawcontent (castPtr ptr)+          -- The lifetime of buf is tied to the lifetime of the blob object in+          -- libgit2, which this Blob object controls, so we can use+          -- unsafePackCStringLen to refer to its bytes.           bstr <- curry unsafePackCStringLen (castPtr buf)                         (fromIntegral size)           let contents' = BlobString bstr           return (b { blobContents = contents' }, contents' )        Nothing -> do-        b' <- lookupBlob (Oid hash) repo+        b' <- lookupBlob repo (Oid hash)         case b' of           Just blobPtr' -> getBlobContents blobPtr'           Nothing       -> return (b, BlobEmpty)

@@ -4,9 +4,12 @@  module Data.Git.Commit        ( Commit(..)+       , PinnedEntry(..)        , newCommitBase        , createCommit        , lookupCommit+       , lookupRefCommit+       , addCommitParent        , writeCommit        , getCommitParents        , modifyCommitTree@@ -22,6 +25,7 @@ import           Data.ByteString.Unsafe import           Data.Git.Common import           Data.Git.Internal+import           Data.Git.Reference import           Data.Git.Tree import qualified Data.Text as T import qualified Data.Text.Encoding as E@@ -49,7 +53,7 @@   getId x        = gitId (commitInfo x)   objectRepo x   = gitRepo (commitInfo x)   objectPtr x    = gitObj (commitInfo x)-  update         = writeCommit Nothing+  update         = flip writeCommit Nothing   lookupFunction = lookupCommit #if defined(PROFILING)   loadObject' x y =@@ -59,28 +63,28 @@ newCommitBase :: Commit -> Base Commit newCommitBase t =   newBase (gitRepo (commitInfo t))-          (Pending (doWriteCommit Nothing >=> return . snd)) Nothing+          (Pending (flip doWriteCommit Nothing >=> return . snd)) Nothing  -- | Create a new, empty commit. -- --   Since empty commits cannot exist in Git, attempting to write out an empty --   commit is a no-op.-createCommit :: Repository -> Commit-createCommit repo =+createCommit :: Repository -> Signature -> Commit+createCommit repo sig =   Commit { commitInfo     =-           newBase repo (Pending (doWriteCommit Nothing >=> return . snd))+           newBase repo (Pending (flip doWriteCommit Nothing >=> return . snd))                    Nothing-         , commitAuthor    = createSignature-         , commitCommitter = createSignature+         , commitAuthor    = sig+         , commitCommitter = sig          , commitTree      = ObjRef (createTree repo)          , commitParents   = []          , commitLog       = T.empty          , commitEncoding  = ""          , commitObj       = Nothing } -lookupCommit :: Oid -> Repository -> IO (Maybe Commit)-lookupCommit oid repo =-  lookupObject' oid repo c'git_commit_lookup c'git_commit_lookup_prefix $+lookupCommit :: Repository -> Oid -> IO (Maybe Commit)+lookupCommit repo oid =+  lookupObject' repo oid c'git_commit_lookup c'git_commit_lookup_prefix $     \coid obj _ ->       withForeignPtr obj $ \cobj -> do         let c = castPtr cobj@@ -112,35 +116,49 @@                       , commitEncoding  = encs                       , commitObj       = Just $ unsafeCoerce obj } +lookupRefCommit :: Repository -> Text -> IO (Maybe Commit)+lookupRefCommit repo ref = do+  oid <- resolveRef repo ref+  maybe (return Nothing) (lookupCommit repo) oid++addCommitParent :: Commit -> Commit -> Commit+addCommitParent co p = co { commitParents = commitParents co ++ [ObjRef p] }+ -- | Write out a commit to its repository.  If it has already been written, --   nothing will happen.-writeCommit :: Maybe Text -> Commit -> IO Commit-writeCommit _ c@(Commit { commitInfo = Base { gitId = Stored _ } }) =+writeCommit :: Commit -> Maybe Text -> IO Commit+writeCommit c@(Commit { commitInfo = Base { gitId = Stored _ } }) _ =   return c-writeCommit ref c = fst <$> doWriteCommit ref c+writeCommit c ref = fst <$> doWriteCommit c ref -doWriteCommit :: Maybe Text -> Commit -> IO (Commit, COid)-doWriteCommit ref c = do+withForeignPtrs :: [ForeignPtr a] -> ([Ptr a] -> IO b) -> IO b+withForeignPtrs fos io+  = do r <- io (map FU.unsafeForeignPtrToPtr fos)+       mapM touchForeignPtr fos+       return r++doWriteCommit :: Commit -> Maybe Text -> IO (Commit, COid)+doWriteCommit c ref = do   coid <- withForeignPtr repo $ \repoPtr -> do     coid <- mallocForeignPtr     withForeignPtr coid $ \coid' -> do       conv <- U.open (commitEncoding c) (Just True)       BS.useAsCString (U.fromUnicode conv (commitLog c)) $ \message ->         withRef ref $ \update_ref ->-          withSignature conv (commitAuthor c) $ \author ->-            withSignature conv (commitCommitter c) $ \committer ->-              withEncStr (commitEncoding c) $ \message_encoding ->-                withGitTree (commitTree c) c $ \commit_tree -> do-                  parentPtrs <- getCommitParentPtrs c-                  parents    <- newArray $-                               map FU.unsafeForeignPtrToPtr parentPtrs-                  r <- c'git_commit_create coid' repoPtr-                        update_ref author committer-                        message_encoding message commit_tree-                        (fromIntegral (length (commitParents c)))-                        parents-                  when (r < 0) $ throwIO CommitCreateFailed-                  return coid+        withSignature conv (commitAuthor c) $ \author ->+        withSignature conv (commitCommitter c) $ \committer ->+        withEncStr (commitEncoding c) $ \message_encoding ->+        withGitTree (commitTree c) c $ \commit_tree -> do+          parentPtrs <- getCommitParentPtrs c+          withForeignPtrs parentPtrs $ \pptrs -> do+            parents <- newArray pptrs+            r <- c'git_commit_create coid' repoPtr+                  update_ref author committer+                  message_encoding message commit_tree+                  (fromIntegral (length (commitParents c)))+                  parents+            when (r < 0) $ throwIO CommitCreateFailed+            return coid    return (c { commitInfo = (commitInfo c) { gitId = Stored (COid coid) } }          , COid coid)@@ -157,11 +175,11 @@  getCommitParents :: Commit -> IO [Commit] getCommitParents c =-  traverse (\p -> do parent <- loadObject p c-                     case parent of-                       Nothing -> error "Cannot find Git commit"-                       Just p' -> return p')-           (commitParents c)+    traverse (\p -> do parent <- loadObject p c+                       case parent of+                           Nothing -> error "Cannot find Git commit"+                           Just p' -> return p')+             (commitParents c)  getCommitParentPtrs :: Commit -> IO [ForeignPtr C'git_commit] getCommitParentPtrs c =@@ -183,34 +201,37 @@               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 =+  :: Commit -> FilePath -> (Maybe TreeEntry -> Either a (Maybe TreeEntry)) -> Bool+  -> IO (Either a Commit)+modifyCommitTree c path f createIfNotExist =   withObject (commitTree c) c $ \tr -> do     result <- modifyTree path f createIfNotExist tr     case result of       Left x    -> return (Left x)       Right tr' -> return $ Right $ c { commitTree = ObjRef tr' } -removeFromCommitTree :: FilePath -> Commit -> IO Commit-removeFromCommitTree path c =+removeFromCommitTree :: Commit -> FilePath -> IO Commit+removeFromCommitTree c path =   withObject (commitTree c) c $ \tr -> do     tr' <- removeFromTree path tr     return c { commitTree = ObjRef tr' } -doUpdateCommit :: [Text] -> TreeEntry -> Commit -> IO Commit-doUpdateCommit xs item c = do-  t <- loadObject (commitTree c) c-  case t of-    Nothing -> error "Failed to load tree for commit"-    Just t' -> do-      tr <- doModifyTree xs (const (Right (Just item))) True t'-      case tr of-        Right tr' -> return c { commitTree = ObjRef tr' }-        _ -> undefined+doUpdateCommit :: Commit -> [Text] -> TreeEntry -> IO Commit+doUpdateCommit c xs item = do+    t <- loadObject (commitTree c) c+    case t of+        Nothing -> throwIO CommitLookupFailed+        Just t' -> do+            newt <- doUpdateTree t' xs item+            return c { commitTree = ObjRef newt+                     , commitInfo =+                            newBase (objectRepo c)+                                    (Pending (flip doWriteCommit Nothing+                                              >=> return . snd)) Nothing+                     , commitObj  = Nothing } -updateCommit :: FilePath -> TreeEntry -> Commit -> IO Commit-updateCommit = doUpdateCommit . splitPath+updateCommit :: Commit -> FilePath -> TreeEntry -> IO Commit+updateCommit c = doUpdateCommit c . splitPath  commitHistoryFirstParent :: Commit -> IO [Commit] commitHistoryFirstParent c =@@ -220,20 +241,26 @@                 ps <- commitHistoryFirstParent p'                 return (c:ps) -commitEntry :: FilePath -> Commit -> IO (Maybe TreeEntry)-commitEntry path c = lookupTreeEntry path =<< loadObject' (commitTree c) c+commitEntry :: Commit -> FilePath -> IO (Maybe TreeEntry)+commitEntry c path =+  flip lookupTreeEntry path =<< loadObject' (commitTree c) c -identifyEntry :: TreeEntry -> IO (Oid,TreeEntry)-identifyEntry x = do+data PinnedEntry = PinnedEntry { pinnedOid    :: Oid+                               , pinnedCommit :: Commit+                               , pinnedEntry  :: TreeEntry }+                 deriving Show++identifyEntry :: Commit -> TreeEntry -> IO PinnedEntry+identifyEntry co x = do   oid <- case x of           BlobEntry blob _ -> objectRefId blob           TreeEntry tree   -> objectRefId tree-  return (oid,x)+  return (PinnedEntry oid co x) -commitEntryHistory :: FilePath -> Commit -> IO [(Oid,TreeEntry)]-commitEntryHistory path c = map head+commitEntryHistory :: Commit -> FilePath -> IO [PinnedEntry]+commitEntryHistory c path = map head                             . filter (not . null)-                            . groupBy ((==) `on` fst) <$> go c+                            . groupBy ((==) `on` pinnedOid) <$> go c   where go co = do           entry <- getEntry co           rest  <- case commitParents co of@@ -242,9 +269,9 @@           return $ maybe rest (:rest) entry          getEntry co = do-          ce <- commitEntry path co+          ce <- commitEntry co path           case ce of             Nothing  -> return Nothing-            Just ce' -> Just <$> identifyEntry ce'+            Just ce' -> Just <$> identifyEntry co ce'  -- Commit.hs

@@ -24,6 +24,7 @@                   | TreeLookupFailed                   | TreeCannotTraverseBlob                   | TreeEntryLookupFailed+                  | TreeUpdateFailed                   | CommitCreateFailed                   | CommitLookupFailed                   | ReferenceCreateFailed

@@ -32,6 +32,7 @@ import           Control.Applicative as X import           Control.Category as X import           Control.Exception as X+import           Control.Lens as X import           Control.Monad as X hiding (mapM, mapM_, sequence, sequence_,                                             forM, forM_, msum, unless, guard) import           Data.Bool as X@@ -104,10 +105,10 @@     Pending _ -> Nothing     Stored y  -> Just (Oid y) -  lookupFunction :: Oid -> Repository -> IO (Maybe a)+  lookupFunction :: Repository -> Oid -> IO (Maybe a)    loadObject :: Updatable b => ObjRef a -> b -> IO (Maybe a)-  loadObject (IdRef coid) y = lookupFunction (Oid coid) (objectRepo y)+  loadObject (IdRef coid) y = lookupFunction (objectRepo y) (Oid coid)   loadObject (ObjRef x) _   = return (Just x)    loadObject' :: Updatable b => ObjRef a -> b -> IO a@@ -122,6 +123,9 @@                              , repoOnWriteRef :: [Reference -> IO ()]                              , repoObj        :: ObjPtr C'git_repository } +instance Eq Repository where+  x == y = repoPath x == repoPath y && repoObj x == repoObj y+ instance Show Repository where   show x = "Repository " <> toString (repoPath x) @@ -133,11 +137,12 @@                            , refName   :: Text                            , refTarget :: RefTarget                            , refObj    :: ObjPtr C'git_reference }-               deriving Show+               deriving (Show, Eq)  data Base a = Base { gitId   :: Ident a                    , gitRepo :: Repository                    , gitObj  :: ObjPtr C'git_object }+            deriving Eq  instance Show (Base a) where   show x = case gitId x of@@ -201,12 +206,12 @@       Just objPtr -> withForeignPtr objPtr (f . castPtr)  lookupObject'-  :: Oid -> Repository+  :: Repository -> Oid   -> (Ptr (Ptr a) -> Ptr C'git_repository -> Ptr C'git_oid -> IO CInt)   -> (Ptr (Ptr a) -> Ptr C'git_repository -> Ptr C'git_oid -> CUInt -> IO CInt)   -> (COid -> ForeignPtr C'git_object -> Ptr C'git_object -> IO b)   -> IO (Maybe b)-lookupObject' oid repo lookupFn lookupPrefixFn createFn =+lookupObject' repo oid lookupFn lookupPrefixFn createFn =   alloca $ \ptr -> do     r <- withForeignPtr (repositoryPtr repo) $ \repoPtr ->            case oid of

@@ -12,6 +12,7 @@ import           Data.Git.Blob import           Data.Git.Commit import           Data.Git.Internal+import           Data.Git.Reference import           Data.Git.Tag import           Data.Git.Tree import qualified Data.Map as M@@ -32,24 +33,29 @@                 | Specifier a  revParse :: CStringable a => NamedRef a -> IO (Maybe Oid)-revParse (FullHash r)    = stringToOid r-revParse (PartialHash r) = stringToOid r+revParse (FullHash r)    = parseOid r+revParse (PartialHash r) = parseOid r revParse (BranchName r)  = undefined revParse (TagName r)     = undefined revParse (RefName r)     = undefined revParse (FullRefName r) = undefined revParse (Specifier r)   = undefined -lookupObject :: Oid -> Repository -> IO (Maybe Object)-lookupObject oid repo =-  lookupObject' oid repo+lookupObject :: Repository -> Oid -> IO (Maybe Object)+lookupObject repo oid =+  lookupObject' repo oid     (\x y z    -> c'git_object_lookup x y z c'GIT_OBJ_ANY)     (\x y z l  -> c'git_object_lookup_prefix x y z l c'GIT_OBJ_ANY)-    (\coid x y -> c'git_object_type y >>= createObject coid x repo)+    (\coid x y -> c'git_object_type y >>= createObject repo coid x) -createObject :: COid -> ForeignPtr C'git_object -> Repository -> C'git_otype+lookupRefObject :: Repository -> Text -> IO (Maybe Object)+lookupRefObject repo ref = do+  oid <- resolveRef repo ref+  maybe (return Nothing) (lookupObject repo) oid++createObject :: Repository -> COid -> ForeignPtr C'git_object -> C'git_otype              -> IO Object-createObject coid obj repo typ+createObject repo coid obj typ   | typ == c'GIT_OBJ_BLOB =     return $ BlobObj Blob { blobInfo =                               newBase repo (Stored coid) (Just obj)

@@ -13,7 +13,7 @@        , compareCOid        , compareCOidLen        , equalCOid-       , stringToOid )+       , parseOid )        where  import           Bindings.Libgit2.Oid@@ -61,6 +61,11 @@ data Ident a = Pending (a -> IO COid)              | Stored COid +instance Eq (Ident a) where+  Pending f1 == Pending f2 = False+  Stored oid1 == Stored oid2 = oid1 == oid2+  _ == _ = False+ instance Show (Ident a) where   show (Pending _) = "Ident..."   show (Stored coid) = show coid@@ -111,18 +116,18 @@ -- | Convert a hash string to a 'Maybe' 'Oid' value.  If the string is less --   than 40 hexadecimal digits, the result will be of type 'PartialOid'. ----- >>> stringToOid "a143ecf"+-- >>> parseOid "a143ecf" -- Just a143ecf--- >>> stringToOid "a143ecf" >>= (\(Just (PartialOid _ l)) -> return $ l == 7)+-- >>> parseOid "a143ecf" >>= (\(Just (PartialOid _ l)) -> return $ l == 7) -- True -- -- >>> let hash = "6cfc2ca31732fb6fa6b54bae6e586a57a0611aab"--- >>> stringToOid hash+-- >>> parseOid hash -- Just 6cfc2ca31732fb6fa6b54bae6e586a57a0611aab--- >>> stringToOid hash >>= (\(Just (Oid _)) -> return True)+-- >>> parseOid hash >>= (\(Just (Oid _)) -> return True) -- True-stringToOid :: CStringable a => a -> IO (Maybe Oid)-stringToOid str+parseOid :: CStringable a => a -> IO (Maybe Oid)+parseOid str   | len > 40 = throwIO ObjectIdTooLong   | otherwise = do     oid <- mallocForeignPtr

@@ -20,13 +20,12 @@        , mapOidRefs        , mapLooseOidRefs        , mapSymbolicRefs-       , lookupId        , writeRef        , writeRef_ )        where  import           Bindings.Libgit2-import           Data.ByteString.Unsafe+import           Data.ByteString import           Data.Git.Internal import           Data.IORef import qualified Data.Text as T@@ -35,26 +34,15 @@ import qualified Prelude import           Prelude ((+),(-)) --- int git_reference_lookup(git_reference **reference_out,---   git_repository *repo, const char *name)--createRef :: Text -> RefTarget -> Repository -> Reference-createRef name target repo =+createRef :: Repository -> Text -> RefTarget -> Reference+createRef repo name target =   Reference { refRepo   = repo             , refName   = name             , refTarget = target             , refObj    = Nothing } -resolveRef :: Text -> Repository -> IO (Maybe Oid)-resolveRef name repo = do-  ref <- lookupRef name repo-  case refTarget <$> ref of-    Nothing                           -> return Nothing-    Just (RefTargetSymbolic nextName) -> resolveRef nextName repo-    Just (RefTargetId oid)            -> return (Just oid)--lookupRef :: Text -> Repository -> IO (Maybe Reference)-lookupRef name repo = alloca $ \ptr -> do+lookupRef :: Repository -> Text -> IO (Maybe Reference)+lookupRef repo name = alloca $ \ptr -> do   r <- withForeignPtr (repositoryPtr repo) $ \repoPtr ->         withCStringable name $ \namePtr ->           c'git_reference_lookup ptr repoPtr namePtr@@ -69,7 +57,7 @@                     newForeignPtr_ oidPtr                       >>= return . RefTargetId . Oid . COid             else do targName <- c'git_reference_target ref-                    unsafePackCString targName+                    packCString targName                       >>= return . RefTargetSymbolic . E.decodeUtf8     return $ Just Reference { refRepo   = repo                             , refName   = name@@ -109,55 +97,17 @@ -- int git_reference_name_to_oid(git_oid *out, git_repository *repo, --   const char *name) -lookupId :: Text -> Repository -> IO Oid-lookupId name repos = alloca $ \ptr ->+resolveRef :: Repository -> Text -> IO (Maybe Oid)+resolveRef repos name = alloca $ \ptr ->   withCStringable name $ \namePtr ->     withForeignPtr repo $ \repoPtr -> do       r <- c'git_reference_name_to_oid ptr repoPtr namePtr-      when (r < 0) $ throwIO ReferenceLookupFailed-      Oid <$> COid <$> newForeignPtr_ ptr-+      if r < 0+        then return Nothing+        else Just . Oid <$> COid <$> newForeignPtr_ ptr   where     repo = fromMaybe (error "Repository invalid") (repoObj repos) --- int git_reference_create_symbolic(git_reference **ref_out,---   git_repository *repo, const char *name, const char *target, int force)----createSymbolicRef = c'git_reference_create_symbolic---- int git_reference_create_oid(git_reference **ref_out, git_repository *repo,---   const char *name, const git_oid *id, int force)----createNamedRef = c'git_reference_create_oid---- const git_oid * git_reference_oid(git_reference *ref)----refId = c'git_reference_oid---- const char * git_reference_target(git_reference *ref)----refTarget = c'git_reference_target---- git_ref_t git_reference_type(git_reference *ref)----refType = c'git_reference_type---- const char * git_reference_name(git_reference *ref)----refName = c'git_reference_name---- int git_reference_resolve(git_reference **resolved_ref, git_reference *ref)----resolveRef = c'git_reference_resolve---- int git_reference_set_target(git_reference *ref, const char *target)----setRefTarget = c'git_reference_set_target---- int git_reference_set_oid(git_reference *ref, const git_oid *id)----setRefId = c'git_reference_set_oid- -- int git_reference_rename(git_reference *ref, const char *new_name, --   int force) @@ -232,15 +182,10 @@       c'git_strarray_free c'refs       return refs ---listRefs = c'git_reference_list---- int git_reference_foreach(git_repository *repo, unsigned int list_flags,---   int (*callback)(const char *, void *), void *payload)- foreachRefCallback :: CString -> Ptr () -> IO CInt foreachRefCallback name payload = do   (callback,results) <- peek (castPtr payload) >>= deRefStablePtr-  result <- unsafePackCString name >>= callback . E.decodeUtf8+  result <- packCString name >>= callback . E.decodeUtf8   modifyIORef results (\xs -> result:xs)   return 0 @@ -270,27 +215,6 @@ mapSymbolicRefs :: Repository -> (Text -> IO a) -> IO [a] mapSymbolicRefs repo = mapRefs repo symbolicRefsFlag -{--foreachRefCallbackThunk :: Storable a =>-                           ForeachRefCallback a -> CString -> Ptr () -> IO CInt-foreachRefCallbackThunk callback name payload = do-  nameText <- E.decodeUtf8 <$> unsafePackCString name-  payloadValue <- peek (castPtr payload)-  maybe (-1) (const 0) <$> callback nameText payloadValue--mapRefsWith ::-  Storable a => Repository -> ListFlags -> a -> ForeachRefCallback a -> IO ()-mapRefsWith repo flags payload cb =-    withForeignPtr (repositoryPtr repo) $ \repoPtr -> do-      fun <- mk'git_reference_foreach_callback (foreachRefCallbackThunk cb)-      with payload $ \payloadPtr -> do-        r <- c'git_reference_foreach repoPtr (flagsToInt flags) fun-                                    (castPtr payloadPtr)-        -- jww (2012-12-14): Does the return type mean anything here?-        when (r < 0) $ return ()-        return ()--}- -- int git_reference_is_packed(git_reference *ref)  --refIsPacked = c'git_reference_is_packed@@ -298,10 +222,6 @@ -- int git_reference_reload(git_reference *ref)  --reloadRef = c'git_reference_reload---- void git_reference_free(git_reference *ref)----freeRef = c'git_reference_free  -- int git_reference_cmp(git_reference *ref1, git_reference *ref2) 

@@ -86,9 +86,9 @@             newBase repo (Pending (doWriteTree >=> return . snd)) Nothing        , treeContents = M.empty } -lookupTree :: Oid -> Repository -> IO (Maybe Tree)-lookupTree oid repo =-  lookupObject' oid repo c'git_tree_lookup c'git_tree_lookup_prefix $+lookupTree :: Repository -> Oid -> IO (Maybe Tree)+lookupTree repo oid =+  lookupObject' repo oid c'git_tree_lookup c'git_tree_lookup_prefix $     \coid obj _ -> do       entriesAList <- withForeignPtr obj $ \treePtr -> do         entryCount <- c'git_tree_entrycount (castPtr treePtr)@@ -116,9 +116,9 @@       return Tree { treeInfo     = newBase repo (Stored coid) (Just obj)                   , treeContents = M.fromList entriesAList } -doLookupTreeEntry :: [Text] -> Tree -> IO (Maybe TreeEntry)-doLookupTreeEntry [] t = return (Just (TreeEntry (ObjRef t)))-doLookupTreeEntry (name:names) t = do+doLookupTreeEntry :: Tree -> [Text] -> IO (Maybe TreeEntry)+doLookupTreeEntry t [] = return (Just (TreeEntry (ObjRef 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@@ -144,11 +144,11 @@     else       case y of         Just (BlobEntry {}) -> throw TreeCannotTraverseBlob-        Just (TreeEntry (ObjRef t')) -> doLookupTreeEntry names t'+        Just (TreeEntry (ObjRef t')) -> doLookupTreeEntry t' names         _ -> return Nothing -lookupTreeEntry :: FilePath -> Tree -> IO (Maybe TreeEntry)-lookupTreeEntry = doLookupTreeEntry . splitPath+lookupTreeEntry :: Tree -> FilePath -> IO (Maybe TreeEntry)+lookupTreeEntry tr = doLookupTreeEntry tr . splitPath  withGitTree :: Updatable b             => ObjRef Tree -> b -> (Ptr C'git_tree -> IO a) -> IO a@@ -304,22 +304,22 @@   -> Tree -> IO (Either a Tree) modifyTree = doModifyTree . splitPath -doUpdateTree :: [Text] -> TreeEntry -> Tree -> IO Tree-doUpdateTree xs item t = do+doUpdateTree :: Tree -> [Text] -> TreeEntry -> IO Tree+doUpdateTree t xs item = do   t' <- doModifyTree xs (const (Right (Just item))) True t   case t' of     Right tr -> return tr-    _ -> undefined+    _ -> throwIO TreeUpdateFailed -updateTree :: FilePath -> TreeEntry -> Tree -> IO Tree-updateTree = doUpdateTree . splitPath+updateTree :: Tree -> FilePath -> TreeEntry -> IO Tree+updateTree tr = doUpdateTree tr . splitPath  removeFromTree :: FilePath -> Tree -> IO Tree removeFromTree p tr = do   t' <- modifyTree p (const (Right Nothing)) False tr   case t' of     Right tr' -> return tr'-    _ -> undefined+    _ -> throwIO TreeUpdateFailed  splitPath :: FilePath -> [Text] splitPath path = T.splitOn "/" text

@@ -19,5 +19,69 @@  {- $intro -   The @gitlib@ library.+   The @gitlib@ library provides high-level types for working with the+   @libgit2@ C library (<http://libgit2.github.com>).  The intention is to+   make @libgit2@ easier and more type-safe, while using laziness to avoid+   unnecessary work.+-}++{- $repositories++   Every use of @gitlib@ must begin with a 'Data.Git.Repository' object.  At+   the moment each 'Repository' must be associated with a local directory,+   even if the Git objects are kept elsewhere via a custom backend (see+   <https://github.com/libgit2/libgit2/issues/1213>).++   If no 'Repository' exists yet, use 'Data.Git.Repository.createRepository';+   if one does exist, use 'Data.Git.Repository.openRepository'; or, you can+   use 'Data.Git.Repository.openOrCreateRepository'.  For example:++> repo <- openOrCreateRepository path False -- False here means "not bare"+> ... make use of the repository ...++   Note that the 'path' variable here is of type 'Filesystem.Path.FilePath',+   since @gitlib@ almost never uses the 'String' type.+-}++{- $references++   If you are working with an existing repository, probably the first thing+   you'll want to do is resolve a reference so that you can lookup a commit:++> repo   <- openOrCreateRepository path False+> ref    <- resolveRef repo "HEAD"+> commit <- maybe (return Nothing) (lookupCommit repo) ref++   'resolveRef' works for both symbolic and specific refs.  Further, this+   pattern is rather common, so there is a shortcut called+   'Data.Git.Commit.lookupRefCommit'.  Or, if you have a SHA string, you can+   use 'Data.Git.Commit.lookupCommit' with 'Data.Git.Oid.parseOid'.++> repo          <- openOrCreateRepository path False+> commitFromRef <- lookupRefCommit repo "HEAD"             :: Maybe Commit+> commitFromSHA <- lookupCommit repo (parseOid "f7acdbed") :: Maybe Commit++-}++{- $commits++   If you don't have a commit object, the recommend way to create one is by+   creating a 'Data.Git.Common.Signature' and using it to modify the return+   value from 'Data.Git.Commit.create'.  This requires a 'Repository' object:++> now <- getCurrentTime+> let sig = Signature {+>               signatureName  = "John Smith"+>             , signatureEmail = "johnsmith@nowhere.org"+>             , signatureWhen  = now }+>     c   = (createCommit repo) {+>             , commitAuthor    = sig+>             , commitCommitter = sig }+>             ++   Load a 'Data.Git.Commit.Commit', and thereafter its history through its+      parents, or load a 'Data.Git.Tree.Tree' or 'Data.Git.Blob.Blob' from+      its contents.++   3. Construct a new commit -}

@@ -1,7 +1,6 @@ Name:                gitlib-Version:             0.5.5+Version:             0.6.4 Synopsis:            Higher-level types for working with hlibgit2-Description:         Higher-level types for working with hlibgit2 License-file:        LICENSE License:             MIT Author:              John Wiegley@@ -9,6 +8,15 @@ Build-Type:          Simple Cabal-Version:       >=1.10 Category:            FFI+Description:+  @gitlib@ is a high-level, lazy and conduit-aware type wrapper around the+  libgit2 C library (<http://libgit2.github.com>).  The aim is both+  type-safety and convenience of use for Haskell users, combined with high+  performance and minimal memory footprint by taking advantage of Haskell's+  laziness and the conduit library's deterministic resource cleanup.+  .+  For further information, as well as typical use cases, see+  "Data.Git.Tutorial".  Source-repository head   type: git

@@ -43,9 +43,9 @@  catBlob :: Repository -> Text -> IO (Maybe Text) catBlob repo sha = do-  hash <- stringToOid sha+  hash <- parseOid sha   for hash $ \hash' -> do-    obj <- lookupObject hash' repo+    obj <- lookupObject repo hash'     case obj of       Just (BlobObj b) -> do         (_, contents) <- getBlobContents b@@ -69,17 +69,15 @@   removeTree p  oid :: Updatable a => a -> IO Text-oid = objectId >=> return . oidToText+oid = objectId >=> return . oidToText . Just -oidToText :: Oid -> Text-oidToText = T.pack . show+oidToText :: Maybe Oid -> Text+oidToText = T.pack . show . fromJust  sampleCommit :: Repository -> Tree -> Signature -> Commit sampleCommit repo tr sig =-    (createCommit repo) { commitTree      = ObjRef tr-                        , commitAuthor    = sig-                        , commitCommitter = sig-                        , commitLog       = "Sample log message." }+    (createCommit repo sig) { commitTree = ObjRef tr+                            , commitLog  = "Sample log message." }  tests :: Test tests = test [@@ -87,7 +85,7 @@   "singleBlob" ~:    withRepository "singleBlob.git" $ \repo -> do-    update_ $ createBlob (E.encodeUtf8 "Hello, world!\n") repo+    update_ $ createBlob repo (E.encodeUtf8 "Hello, world!\n")      x <- catBlob repo "af5626b4a114abcb82d63db7c8082c3c4756e51b"     x @?= Just "Hello, world!\n"@@ -100,8 +98,8 @@   , "singleTree" ~:    withRepository "singleTree.git" $ \repo -> do-    let hello = createBlob (E.encodeUtf8 "Hello, world!\n") repo-    tr <- updateTree "hello/world.txt" (blobRef hello) (createTree repo)+    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")+    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)     x  <- oid tr     x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271" @@ -110,13 +108,13 @@   , "twoTrees" ~:    withRepository "twoTrees.git" $ \repo -> do-    let hello = createBlob (E.encodeUtf8 "Hello, world!\n") repo-    tr <- updateTree "hello/world.txt" (blobRef hello) (createTree repo)+    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")+    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)     x  <- oid tr     x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271" -    let goodbye = createBlob (E.encodeUtf8 "Goodbye, world!\n") repo-    tr <- updateTree "goodbye/files/world.txt" (blobRef goodbye) tr+    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")+    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)     x  <- oid tr     x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a" @@ -125,13 +123,13 @@   , "deleteTree" ~:    withRepository "deleteTree.git" $ \repo -> do-    let hello = createBlob (E.encodeUtf8 "Hello, world!\n") repo-    tr <- updateTree "hello/world.txt" (blobRef hello) (createTree repo)+    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")+    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)     x  <- oid tr     x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271" -    let goodbye = createBlob (E.encodeUtf8 "Goodbye, world!\n") repo-    tr <- updateTree "goodbye/files/world.txt" (blobRef goodbye) tr+    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")+    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)     x  <- oid tr     x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a" @@ -147,11 +145,11 @@   , "createCommit" ~:    withRepository "createCommit.git" $ \repo -> do-    let hello = createBlob (E.encodeUtf8 "Hello, world!\n") repo-    tr <- updateTree "hello/world.txt" (blobRef hello) (createTree repo)+    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")+    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello) -    let goodbye = createBlob (E.encodeUtf8 "Goodbye, world!\n") repo-    tr <- updateTree "goodbye/files/world.txt" (blobRef goodbye) tr+    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")+    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)     x  <- oid tr     x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a" @@ -177,11 +175,11 @@     backend   <- traceBackend loosePtr'     odbBackendAdd repo backend 3 -    let hello = createBlob (E.encodeUtf8 "Hello, world!\n") repo-    tr <- updateTree "hello/world.txt" (blobRef hello) (createTree repo)+    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")+    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello) -    let goodbye = createBlob (E.encodeUtf8 "Goodbye, world!\n") repo-    tr <- updateTree "goodbye/files/world.txt" (blobRef goodbye) tr+    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")+    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)     tr <- update tr     x  <- oid tr     x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"@@ -197,8 +195,8 @@     x <- oid c     x @?= "44381a5e564d19893d783a5d5c59f9c745155b56" -    let goodbye2 = createBlob (E.encodeUtf8 "Goodbye, world again!\n") repo-    tr <- updateTree "goodbye/files/world.txt" (blobRef goodbye2) tr+    let goodbye2 = createBlob repo (E.encodeUtf8 "Goodbye, world again!\n")+    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye2)     tr <- update tr     x  <- oid tr     x @?= "f2b42168651a45a4b7ce98464f09c7ec7c06d706"@@ -215,10 +213,10 @@      c2 <- update c2     cid <- objectId c2-    writeRef $ createRef "refs/heads/master" (RefTargetId cid) repo-    writeRef $ createRef "HEAD" (RefTargetSymbolic "refs/heads/master") repo+    writeRef $ createRef repo "refs/heads/master" (RefTargetId cid)+    writeRef $ createRef repo "HEAD" (RefTargetSymbolic "refs/heads/master") -    x <- oidToText <$> lookupId "refs/heads/master" repo+    x <- oidToText <$> resolveRef repo "refs/heads/master"     x @?= "2506e7fcc2dbfe4c083e2bd741871e2e14126603"      mapAllRefs repo (\name -> Prelude.putStrLn $ "Ref: " ++ unpack name)@@ -226,18 +224,54 @@     ehist <- commitHistoryFirstParent c2     Prelude.putStrLn $ "ehist: " ++ show ehist -    ehist2 <- commitEntryHistory "goodbye/files/world.txt" c2+    ehist2 <- commitEntryHistory c2 "goodbye/files/world.txt"     Prelude.putStrLn $ "ehist2: " ++ show ehist2 -    -- oid <- stringToOid ("2506e7fc" :: Text)+    -- oid <- parseOid ("2506e7fc" :: Text)     -- c3 <- lookupCommit (fromJust oid) repo     -- ehist3 <- commitEntryHistory "goodbye/files/world.txt" (fromJust c3)     -- Prelude.putStrLn $ "ehist3: " ++ show ehist3 -    oid <- stringToOid ("2506e7fc" :: Text)-    c4 <- lookupCommit (fromJust oid) repo-    ehist4 <- commitEntryHistory "goodbye/files/world.txt" (fromJust c4)+    oid <- parseOid ("2506e7fc" :: Text)+    c4 <- lookupCommit repo (fromJust oid)+    c5 <- maybe (return Nothing) (lookupCommit repo) oid+    c6 <- lookupCommit repo (fromJust oid)+    ehist4 <- commitEntryHistory (fromJust c4) "goodbye/files/world.txt"     Prelude.putStrLn $ "ehist4: " ++ show (Prelude.head ehist4)++  , "smallTest1" ~:++  withRepository "smallTest1.git" $ \repo -> do+    let blob =+          createBlob repo "# Auto-created repository for tutorial contents\n"+        masterRef = "refs/heads/master"+        sig = Signature { signatureName   = "First Name"+                        , signatureEmail = "user1@email.org"+                        , signatureWhen  = posixSecondsToUTCTime 1348981883 }+    tree <- updateTree (createTree repo) "README.md" (blobRef blob)+    commit <- writeCommit (createCommit repo sig)+            { commitLog       = "Initial commit"+            , commitTree      = ObjRef tree+            } (Just masterRef)+    c1id <- objectId commit+    print $ "commit1 sha = " ++ show c1id++    let sig2 = Signature { signatureName   = "Second Name"+                         , signatureEmail = "user2@email.org"+                         , signatureWhen  = posixSecondsToUTCTime 1348982883 }+    blob <- writeBlob $ createBlob repo "This is some content."+    blobOID <- objectId blob+    commit' <- updateCommit commit {+          commitAuthor = sig+        , commitCommitter = sig+        , commitLog = "This is another log message."+        , commitParents = [ObjRef commit]+        } "foo.txt" (blobRef blob)+    commitOID <- objectId commit'+    print $ "commit2 sha = " ++ show commitOID+    writeRef_ $ createRef repo masterRef $ RefTargetId commitOID++    True @?= True      return ()