diff --git a/Data/Git.hs b/Data/Git.hs --- a/Data/Git.hs +++ b/Data/Git.hs @@ -1,3 +1,13 @@ +{-| @gitlib@ is a high-level, lazy and conduit-aware type wrapper around the + libgit2 C library (). 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". +-} + module Data.Git ( module Data.Git.Repository, -- module Data.Git.Config, diff --git a/Data/Git/Backend.hs b/Data/Git/Backend.hs --- a/Data/Git/Backend.hs +++ b/Data/Git/Backend.hs @@ -18,8 +18,6 @@ import Data.Git.Internal import qualified Prelude -default (Text) - type F'git_odb_backend_read_callback = Ptr (Ptr ()) -> Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt diff --git a/Data/Git/Blob.hs b/Data/Git/Blob.hs --- a/Data/Git/Blob.hs +++ b/Data/Git/Blob.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ViewPatterns #-} @@ -6,10 +7,12 @@ module Data.Git.Blob ( Blob(..) , BlobContents(..) + , ByteSource , newBlobBase , createBlob , getBlobContents , blobSourceToString + , lookupBlob , writeBlob ) where @@ -20,8 +23,6 @@ import Data.Git.Error import Data.Git.Internal import qualified Prelude - -default (Text) data BlobContents = BlobEmpty | BlobString B.ByteString @@ -40,19 +41,22 @@ instance Show Blob where show x = case gitId (blobInfo x) of - Pending _ -> "Blob" + Pending _ -> "Blob..." Stored y -> "Blob#" ++ show y instance Updatable Blob where - getId x = gitId (blobInfo x) - objectRepo x = gitRepo (blobInfo x) - objectPtr x = gitObj (blobInfo x) + getId = gitId . blobInfo + objectRepo = gitRepo . blobInfo + objectPtr = gitObj . blobInfo update = writeBlob lookupFunction = lookupBlob +#if defined(PROFILING) + loadObject' x y = + maybe (throwIO ObjectLookupFailed) return =<< loadObject x y +#endif newBlobBase :: Blob -> Base Blob -newBlobBase b = - newBase (gitRepo (blobInfo b)) (Pending doWriteBlob) Nothing +newBlobBase b = newBase (gitRepo (blobInfo b)) (Pending doWriteBlob) Nothing -- | Create a new blob in the 'Repository', with 'ByteString' as its contents. -- diff --git a/Data/Git/Commit.hs b/Data/Git/Commit.hs --- a/Data/Git/Commit.hs +++ b/Data/Git/Commit.hs @@ -1,7 +1,21 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} -module Data.Git.Commit where +module Data.Git.Commit + ( Commit(..) + , newCommitBase + , createCommit + , lookupCommit + , writeCommit + , getCommitParents + , modifyCommitTree + , removeFromCommitTree + , updateCommit + , commitHistoryFirstParent + , commitEntry + , commitEntryHistory ) + where import Bindings.Libgit2 import qualified Data.ByteString as BS @@ -16,8 +30,6 @@ import qualified Foreign.ForeignPtr.Unsafe as FU import Foreign.Marshal.Array import qualified Prelude - -default (Text) data Commit = Commit { commitInfo :: Base Commit , commitAuthor :: Signature @@ -30,8 +42,8 @@ instance Show Commit where show x = case gitId (commitInfo x) of - Pending _ -> "Commit" - Stored y -> "Commit#" ++ show y + Pending _ -> "Commit..." + Stored y -> "Commit#" ++ show y ++ " <" ++ show (commitTree x) ++ ">" instance Updatable Commit where getId x = gitId (commitInfo x) @@ -39,6 +51,10 @@ objectPtr x = gitObj (commitInfo x) update = writeCommit Nothing lookupFunction = lookupCommit +#if defined(PROFILING) + loadObject' x y = + maybe (throwIO ObjectLookupFailed) return =<< loadObject x y +#endif newCommitBase :: Commit -> Base Commit newCommitBase t = @@ -133,15 +149,11 @@ repo = fromMaybe (error "Repository invalid") (repoObj (gitRepo (commitInfo c))) - withRef refName = - if isJust refName - then unsafeUseAsCString (E.encodeUtf8 (fromJust refName)) - else flip ($) nullPtr + withRef Nothing = flip ($) nullPtr + withRef (Just name) = BS.useAsCString (E.encodeUtf8 name) - withEncStr enc = - if null enc - then flip ($) nullPtr - else withCString enc + withEncStr "" = flip ($) nullPtr + withEncStr enc = withCString enc getCommitParents :: Commit -> IO [Commit] getCommitParents c = @@ -199,5 +211,40 @@ updateCommit :: FilePath -> TreeEntry -> Commit -> IO Commit updateCommit = doUpdateCommit . splitPath + +commitHistoryFirstParent :: Commit -> IO [Commit] +commitHistoryFirstParent c = + case commitParents c of + [] -> return [c] + (p:_) -> do p' <- loadObject' p c + ps <- commitHistoryFirstParent p' + return (c:ps) + +commitEntry :: FilePath -> Commit -> IO (Maybe TreeEntry) +commitEntry path c = lookupTreeEntry path =<< loadObject' (commitTree c) c + +identifyEntry :: TreeEntry -> IO (Oid,TreeEntry) +identifyEntry x = do + oid <- case x of + BlobEntry blob _ -> objectRefId blob + TreeEntry tree -> objectRefId tree + return (oid,x) + +commitEntryHistory :: FilePath -> Commit -> IO [(Oid,TreeEntry)] +commitEntryHistory path c = map head + . filter (not . null) + . groupBy ((==) `on` fst) <$> go c + where go co = do + entry <- getEntry co + rest <- case commitParents co of + [] -> return [] + (p:_) -> go =<< loadObject' p co + return $ maybe rest (:rest) entry + + getEntry co = do + ce <- commitEntry path co + case ce of + Nothing -> return Nothing + Just ce' -> Just <$> identifyEntry ce' -- Commit.hs diff --git a/Data/Git/Common.hs b/Data/Git/Common.hs --- a/Data/Git/Common.hs +++ b/Data/Git/Common.hs @@ -18,8 +18,6 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import qualified Prelude - -default (Text) data Signature = Signature { signatureName :: Text , signatureEmail :: Text diff --git a/Data/Git/Internal.hs b/Data/Git/Internal.hs --- a/Data/Git/Internal.hs +++ b/Data/Git/Internal.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -22,6 +22,9 @@ , withObject , withObjectPtr + , RefTarget(..) + , Reference(..) + , module X ) where @@ -30,7 +33,7 @@ import Control.Category as X import Control.Exception as X import Control.Monad as X hiding (mapM, mapM_, sequence, sequence_, - forM, forM_, msum) + forM, forM_, msum, unless, guard) import Data.Bool as X import Data.ByteString as B hiding (map) import Data.Conduit @@ -63,10 +66,9 @@ import Foreign.Storable as X import Prelude as X (undefined, error, otherwise, IO, Show, show, Enum, Eq, Ord, (<), (==), (/=), round, Int, - Integer, fromIntegral, fromInteger, toInteger) + Integer, fromIntegral, fromInteger, toInteger, + putStrLn, (-), (+)) import Unsafe.Coerce as X - -default (Text) type ObjPtr a = Maybe (ForeignPtr a) @@ -93,6 +95,10 @@ Oid coid -> return (IdRef coid) PartialOid _ _ -> error "Did not expect to see a PartialOid" + objectRefId :: ObjRef a -> IO Oid + objectRefId (IdRef coid) = return (Oid coid) + objectRefId (ObjRef x) = objectId x + maybeObjectId :: a -> Maybe Oid maybeObjectId x = case getId x of Pending _ -> Nothing @@ -104,15 +110,30 @@ loadObject (IdRef coid) y = lookupFunction (Oid coid) (objectRepo y) loadObject (ObjRef x) _ = return (Just x) + loadObject' :: Updatable b => ObjRef a -> b -> IO a + loadObject' x y = + maybe (throwIO ObjectLookupFailed) return =<< loadObject x y + getObject :: ObjRef a -> Maybe a getObject (IdRef _) = Nothing getObject (ObjRef x) = Just x -data Repository = Repository { repoPath :: FilePath - , repoObj :: ObjPtr C'git_repository } +data Repository = Repository { repoPath :: FilePath + , repoOnWriteRef :: [Reference -> IO ()] + , repoObj :: ObjPtr C'git_repository } instance Show Repository where show x = "Repository " <> toString (repoPath x) + +data RefTarget = RefTargetId Oid + | RefTargetSymbolic Text + deriving (Show, Eq) + +data Reference = Reference { refRepo :: Repository + , refName :: Text + , refTarget :: RefTarget + , refObj :: ObjPtr C'git_reference } + deriving Show data Base a = Base { gitId :: Ident a , gitRepo :: Repository @@ -120,8 +141,8 @@ instance Show (Base a) where show x = case gitId x of - Pending _ -> "Base" - Stored y -> "Base#" ++ show y + Pending _ -> "Base..." + Stored y -> "Base#" ++ show y newBase :: Repository -> Ident a -> ObjPtr C'git_object -> Base a newBase repo oid obj = Base { gitId = oid @@ -141,8 +162,8 @@ openOrCreateRepository :: FilePath -> Bool -> IO Repository openOrCreateRepository path bare = do - b <- isDirectory path - if b + p <- isDirectory path + if p then openRepository path else createRepository path bare @@ -158,8 +179,9 @@ when (r < 0) $ doesNotExist p ptr' <- peek ptr fptr <- newForeignPtr p'git_repository_free ptr' - return Repository { repoPath = path - , repoObj = Just fptr } + return Repository { repoPath = path + , repoOnWriteRef = [] + , repoObj = Just fptr } where doesNotExist = throwIO . RepositoryNotExist . toString diff --git a/Data/Git/Oid.hs b/Data/Git/Oid.hs --- a/Data/Git/Oid.hs +++ b/Data/Git/Oid.hs @@ -62,7 +62,7 @@ | Stored COid instance Show (Ident a) where - show (Pending _) = "Pending" + show (Pending _) = "Ident..." show (Stored coid) = show coid -- | 'Oid' represents either a full or partial SHA1 hash code used to identify diff --git a/Data/Git/Reference.hs b/Data/Git/Reference.hs --- a/Data/Git/Reference.hs +++ b/Data/Git/Reference.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -6,8 +7,10 @@ ( RefTarget(..) , Reference(..) , createRef + , resolveRef , lookupRef , listRefNames + , ListFlags , allRefsFlag , oidRefsFlag , looseOidRefsFlag @@ -25,24 +28,13 @@ import Bindings.Libgit2 import Data.ByteString.Unsafe import Data.Git.Internal +import Data.IORef import qualified Data.Text as T import qualified Data.Text.Encoding as E import Foreign.Marshal.Array import qualified Prelude import Prelude ((+),(-)) - -default (Text) -data RefTarget = RefTargetId Oid - | RefTargetSymbolic Text - deriving (Show, Eq) - -data Reference = Reference { refRepo :: Repository - , refName :: Text - , refTarget :: RefTarget - , refObj :: ObjPtr C'git_reference } - deriving Show - -- int git_reference_lookup(git_reference **reference_out, -- git_repository *repo, const char *name) @@ -53,6 +45,14 @@ , 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 r <- withForeignPtr (repositoryPtr repo) $ \repoPtr -> @@ -63,10 +63,18 @@ else do ref <- peek ptr fptr <- newForeignPtr p'git_reference_free ref - return $ Just $ Reference { refRepo = repo - , refName = name - , refTarget = undefined - , refObj = Just fptr } + typ <- c'git_reference_type ref + targ <- if typ == c'GIT_REF_OID + then do oidPtr <- c'git_reference_oid ref + newForeignPtr_ oidPtr + >>= return . RefTargetId . Oid . COid + else do targName <- c'git_reference_target ref + unsafePackCString targName + >>= return . RefTargetSymbolic . E.decodeUtf8 + return $ Just Reference { refRepo = repo + , refName = name + , refTarget = targ + , refObj = Just fptr } writeRef :: Reference -> IO Reference writeRef ref = alloca $ \ptr -> do @@ -88,7 +96,9 @@ when (r < 0) $ throwIO ReferenceCreateFailed fptr <- newForeignPtr_ =<< peek ptr - return ref { refObj = Just fptr } + let ref' = ref { refObj = Just fptr } + mapM_ ($ ref') (repoOnWriteRef (refRepo ref')) + return ref' where repo = fromMaybe (error "Repository invalid") (repoObj (refRepo ref)) @@ -227,30 +237,37 @@ -- int git_reference_foreach(git_repository *repo, unsigned int list_flags, -- int (*callback)(const char *, void *), void *payload) -type ForeachRefCallback = Text -> IO () - -foreachRefCallbackThunk :: ForeachRefCallback -> CString -> Ptr () -> IO CInt -foreachRefCallbackThunk callback name _ = do - nameText <- E.decodeUtf8 <$> unsafePackCString name - callback nameText +foreachRefCallback :: CString -> Ptr () -> IO CInt +foreachRefCallback name payload = do + (callback,results) <- peek (castPtr payload) >>= deRefStablePtr + result <- unsafePackCString name >>= callback . E.decodeUtf8 + modifyIORef results (\xs -> result:xs) return 0 -mapRefs :: Repository -> ListFlags -> ForeachRefCallback -> IO () -mapRefs repo flags cb = - withForeignPtr (repositoryPtr repo) $ \repoPtr -> do - fun <- mk'git_reference_foreach_callback (foreachRefCallbackThunk cb) - r <- c'git_reference_foreach repoPtr (flagsToInt flags) fun nullPtr - -- jww (2012-12-14): Does the return type mean anything here? - when (r < 0) $ return () - return () +foreign export ccall "foreachRefCallback" + foreachRefCallback :: CString -> Ptr () -> IO CInt +foreign import ccall "&foreachRefCallback" + foreachRefCallbackPtr :: FunPtr (CString -> Ptr () -> IO CInt) -mapAllRefs :: Repository -> ForeachRefCallback -> IO () +mapRefs :: Repository -> ListFlags -> (Text -> IO a) -> IO [a] +mapRefs repo flags callback = do + ioRef <- newIORef [] + bracket + (newStablePtr (callback,ioRef)) + deRefStablePtr + (\ptr -> with ptr $ \pptr -> + withForeignPtr (repositoryPtr repo) $ \repoPtr -> do + _ <- c'git_reference_foreach repoPtr (flagsToInt flags) + foreachRefCallbackPtr (castPtr pptr) + readIORef ioRef) + +mapAllRefs :: Repository -> (Text -> IO a) -> IO [a] mapAllRefs repo = mapRefs repo allRefsFlag -mapOidRefs :: Repository -> ForeachRefCallback -> IO () +mapOidRefs :: Repository -> (Text -> IO a) -> IO [a] mapOidRefs repo = mapRefs repo oidRefsFlag -mapLooseOidRefs :: Repository -> ForeachRefCallback -> IO () +mapLooseOidRefs :: Repository -> (Text -> IO a) -> IO [a] mapLooseOidRefs repo = mapRefs repo looseOidRefsFlag -mapSymbolicRefs :: Repository -> ForeachRefCallback -> IO () +mapSymbolicRefs :: Repository -> (Text -> IO a) -> IO [a] mapSymbolicRefs repo = mapRefs repo symbolicRefsFlag {- diff --git a/Data/Git/Repository.hs b/Data/Git/Repository.hs --- a/Data/Git/Repository.hs +++ b/Data/Git/Repository.hs @@ -9,10 +9,11 @@ , Updatable(..) - , Repository + , Repository(..) , openRepository , createRepository , openOrCreateRepository + , repositoryPtr , lookupObject' , withObject diff --git a/Data/Git/Tag.hs b/Data/Git/Tag.hs --- a/Data/Git/Tag.hs +++ b/Data/Git/Tag.hs @@ -6,15 +6,13 @@ import Data.Git.Internal import qualified Data.Text as T import qualified Prelude - -default (Text) data Tag = Tag { tagInfo :: Base Tag , tagRef :: Oid } instance Show Tag where show x = case gitId (tagInfo x) of - Pending _ -> "Tag" + Pending _ -> "Tag..." Stored y -> "Tag#" ++ show y -- Tag.hs diff --git a/Data/Git/Tree.hs b/Data/Git/Tree.hs --- a/Data/Git/Tree.hs +++ b/Data/Git/Tree.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} @@ -15,8 +16,6 @@ import qualified Data.Text as T import qualified Filesystem.Path.CurrentOS as F import qualified Prelude - -default (Text) data TreeEntry = BlobEntry { blobEntry :: ObjRef Blob , blobEntryIsExe :: Bool } @@ -54,12 +53,12 @@ instance Show Tree where show x = case gitId (treeInfo x) of - Pending _ -> "Tree" - Stored y -> "Tree#" ++ show y + Pending _ -> "Tree..." + Stored y -> "Tree#" ++ show y instance Show TreeEntry where - show be@(BlobEntry {}) = show be - show te@(TreeEntry {}) = show te + show (BlobEntry blob _) = "BlobEntry (" ++ show blob ++ ")" + show (TreeEntry tree) = "TreeEntry (" ++ show tree ++ ")" instance Updatable Tree where getId x = gitId (treeInfo x) @@ -67,6 +66,10 @@ objectPtr x = gitObj (treeInfo x) update = writeTree lookupFunction = lookupTree +#if defined(PROFILING) + loadObject' x y = + maybe (throwIO ObjectLookupFailed) return =<< loadObject x y +#endif newTreeBase :: Tree -> Base Tree newTreeBase t = @@ -79,7 +82,7 @@ -- tree is a no-op. createTree :: Repository -> Tree createTree repo = - Tree { treeInfo = + Tree { treeInfo = newBase repo (Pending (doWriteTree >=> return . snd)) Nothing , treeContents = M.empty } @@ -87,12 +90,13 @@ lookupTree oid repo = lookupObject' oid repo c'git_tree_lookup c'git_tree_lookup_prefix $ \coid obj _ -> do - entriesMap <- withForeignPtr obj $ \treePtr -> do + entriesAList <- withForeignPtr obj $ \treePtr -> do entryCount <- c'git_tree_entrycount (castPtr treePtr) foldM (\m idx -> do entry <- c'git_tree_entry_byindex (castPtr treePtr) (fromIntegral idx) + when (entry == nullPtr) $ throwIO ObjectLookupFailed entryId <- c'git_tree_entry_id entry coid <- mallocForeignPtr withForeignPtr coid $ \coid' -> @@ -107,11 +111,10 @@ then BlobEntry (IdRef (COid coid)) False else TreeEntry (IdRef (COid coid)) - return $ M.insert entryName entryObj m) - M.empty [1..entryCount] - return Tree { treeInfo = - newBase repo (Stored coid) (Just obj) - , treeContents = entriesMap } + return ((entryName,entryObj):m)) + [] [0..(entryCount-1)] + 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))) @@ -120,9 +123,10 @@ -- 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. - Prelude.putStrLn $ "Tree: " ++ show t - Prelude.putStrLn $ "Tree Entries: " ++ show (treeContents t) - Prelude.putStrLn $ "Lookup: " ++ toString name + + -- Prelude.putStrLn $ "Tree: " ++ show t + -- Prelude.putStrLn $ "Tree Entries: " ++ show (treeContents t) + -- Prelude.putStrLn $ "Lookup: " ++ toString name y <- case M.lookup name (treeContents t) of Nothing -> return Nothing Just j -> case j of @@ -133,8 +137,8 @@ tr <- loadObject t' t for tr $ \x -> return $ TreeEntry (ObjRef x) - Prelude.putStrLn $ "Result: " ++ show y - Prelude.putStrLn $ "Names: " ++ show names + -- Prelude.putStrLn $ "Result: " ++ show y + -- Prelude.putStrLn $ "Names: " ++ show names if null names then return y else @@ -192,13 +196,15 @@ case v of BlobEntry bl exe -> withObject bl t $ \bl' -> do - (Oid coid) <- objectId bl' - return (k, BlobEntry (IdRef coid) exe, coid, + bl'' <- update bl' + (Oid coid) <- objectId bl'' + return (k, BlobEntry (ObjRef bl'') exe, coid, if exe then 0o100755 else 0o100644) TreeEntry tr -> withObject tr t $ \tr' -> do - (Oid coid) <- objectId tr' - return (k, TreeEntry (IdRef coid), coid, 0o040000) + tr'' <- update tr' + (Oid coid) <- objectId tr'' + return (k, TreeEntry (ObjRef tr''), coid, 0o040000) newList <- for oids $ \(k, entry, coid, flags) -> do insertObject builder k coid flags diff --git a/Data/Git/Tutorial.hs b/Data/Git/Tutorial.hs new file mode 100644 --- /dev/null +++ b/Data/Git/Tutorial.hs @@ -0,0 +1,23 @@ +{-| This module provides a brief introductory tutorial in the \"Introduction\" + section followed by a lengthy discussion of the library's design and idioms. +-} + +module Data.Git.Tutorial + ( + -- * Introduction + -- $intro + + -- * Repositories + -- $repositories + + -- * References + -- $references + + -- * Commits + -- $commits + ) where + +{- $intro + + The @gitlib@ library. +-} diff --git a/gitlib.cabal b/gitlib.cabal --- a/gitlib.cabal +++ b/gitlib.cabal @@ -1,5 +1,5 @@ Name: gitlib -Version: 0.5.2 +Version: 0.5.5 Synopsis: Higher-level types for working with hlibgit2 Description: Higher-level types for working with hlibgit2 License-file: LICENSE @@ -44,9 +44,8 @@ , filepath >= 1.3 && < 1.4 Library - default-language: Haskell98 - default-extensions: - ForeignFunctionInterface + default-language: Haskell98 + default-extensions: ForeignFunctionInterface build-depends: base >= 3 && < 5 , hlibgit2 >= 0.17 @@ -69,11 +68,13 @@ Data.Git.Commit Data.Git.Common Data.Git.Error + Data.Git.Internal Data.Git.Object Data.Git.Oid + Data.Git.Reference Data.Git.Repository Data.Git.Tag Data.Git.Tree - Data.Git.Reference - other-modules: - Data.Git.Internal + Data.Git.Tutorial + -- other-modules: + -- Data.Git.Internal diff --git a/test/Smoke.hs b/test/Smoke.hs --- a/test/Smoke.hs +++ b/test/Smoke.hs @@ -90,10 +90,10 @@ update_ $ createBlob (E.encodeUtf8 "Hello, world!\n") repo x <- catBlob repo "af5626b4a114abcb82d63db7c8082c3c4756e51b" - x @?= (Just "Hello, world!\n") + x @?= Just "Hello, world!\n" x <- catBlob repo "af5626b" - x @?= (Just "Hello, world!\n") + x @?= Just "Hello, world!\n" return () @@ -182,6 +182,7 @@ let goodbye = createBlob (E.encodeUtf8 "Goodbye, world!\n") repo tr <- updateTree "goodbye/files/world.txt" (blobRef goodbye) tr + tr <- update tr x <- oid tr x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a" @@ -192,11 +193,13 @@ , signatureEmail = "johnw@newartisans.com" , signatureWhen = posixSecondsToUTCTime 1348980883 } c = sampleCommit repo tr sig + c <- update c x <- oid c x @?= "44381a5e564d19893d783a5d5c59f9c745155b56" let goodbye2 = createBlob (E.encodeUtf8 "Goodbye, world again!\n") repo tr <- updateTree "goodbye/files/world.txt" (blobRef goodbye2) tr + tr <- update tr x <- oid tr x @?= "f2b42168651a45a4b7ce98464f09c7ec7c06d706" @@ -210,6 +213,7 @@ x <- oid c2 x @?= "2506e7fcc2dbfe4c083e2bd741871e2e14126603" + c2 <- update c2 cid <- objectId c2 writeRef $ createRef "refs/heads/master" (RefTargetId cid) repo writeRef $ createRef "HEAD" (RefTargetSymbolic "refs/heads/master") repo @@ -219,7 +223,23 @@ mapAllRefs repo (\name -> Prelude.putStrLn $ "Ref: " ++ unpack name) - return() + ehist <- commitHistoryFirstParent c2 + Prelude.putStrLn $ "ehist: " ++ show ehist + + ehist2 <- commitEntryHistory "goodbye/files/world.txt" c2 + Prelude.putStrLn $ "ehist2: " ++ show ehist2 + + -- oid <- stringToOid ("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) + Prelude.putStrLn $ "ehist4: " ++ show (Prelude.head ehist4) + + return () ]