packages feed

hit 0.4.3 → 0.5.0

raw patch · 8 files changed

+230/−179 lines, 8 filesdep ~hashablePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hashable

API changes (from Hackage documentation)

+ Data.Git.Ref: RefInvalid :: ByteString -> RefInvalid
+ Data.Git.Ref: RefNotFound :: Ref -> RefNotFound
+ Data.Git.Ref: data RefInvalid
+ Data.Git.Ref: data RefNotFound
+ Data.Git.Ref: instance Data Ref
+ Data.Git.Ref: instance Data RefInvalid
+ Data.Git.Ref: instance Data RefNotFound
+ Data.Git.Ref: instance Eq RefInvalid
+ Data.Git.Ref: instance Eq RefNotFound
+ Data.Git.Ref: instance Exception RefInvalid
+ Data.Git.Ref: instance Exception RefNotFound
+ Data.Git.Ref: instance Show RefInvalid
+ Data.Git.Ref: instance Show RefNotFound
+ Data.Git.Ref: instance Typeable Ref
+ Data.Git.Ref: instance Typeable RefInvalid
+ Data.Git.Ref: instance Typeable RefNotFound
+ Data.Git.Repository: getCommitMaybe :: Git -> Ref -> IO (Maybe Commit)
+ Data.Git.Repository: getTreeMaybe :: Git -> Ref -> IO (Maybe Tree)
+ Data.Git.Repository: instance Data InvalidType
+ Data.Git.Repository: instance Eq InvalidType
+ Data.Git.Repository: instance Exception InvalidType
+ Data.Git.Repository: instance Show InvalidType
+ Data.Git.Repository: instance Typeable InvalidType
+ Data.Git.Revision: RevisionNotFound :: Revision -> RevisionNotFound
+ Data.Git.Revision: data RevisionNotFound
+ Data.Git.Revision: instance Data RevModifier
+ Data.Git.Revision: instance Data Revision
+ Data.Git.Revision: instance Data RevisionNotFound
+ Data.Git.Revision: instance Eq RevisionNotFound
+ Data.Git.Revision: instance Show RevisionNotFound
+ Data.Git.Revision: instance Typeable RevModifier
+ Data.Git.Revision: instance Typeable Revision
+ Data.Git.Revision: instance Typeable RevisionNotFound
+ Data.Git.Storage: getObject_ :: Git -> Ref -> Bool -> IO Object
+ Data.Git.Types: instance Data ObjectType
+ Data.Git.Types: instance Typeable ObjectType
- Data.Git: getCommit :: Git -> Ref -> IO (Maybe Commit)
+ Data.Git: getCommit :: Git -> Ref -> IO Commit
- Data.Git: getTree :: Git -> Ref -> IO (Maybe Tree)
+ Data.Git: getTree :: Git -> Ref -> IO Tree
- Data.Git.Repository: getCommit :: Git -> Ref -> IO (Maybe Commit)
+ Data.Git.Repository: getCommit :: Git -> Ref -> IO Commit
- Data.Git.Repository: getTree :: Git -> Ref -> IO (Maybe Tree)
+ Data.Git.Repository: getTree :: Git -> Ref -> IO Tree

Files

Data/Git/Ref.hs view
@@ -5,22 +5,29 @@ -- Stability   : experimental -- Portability : unix --+{-# LANGUAGE DeriveDataTypeable #-} module Data.Git.Ref-        ( Ref-        , isHex-        , isHexString-        , fromHex-        , fromHexString-        , fromBinary-        , toBinary-        , toHex-        , toHexString-        , refPrefix-        , cmpPrefix-        , toFilePathParts-        , hash-        , hashLBS-        ) where+    ( Ref+    -- * Exceptions+    , RefInvalid(..)+    , RefNotFound(..)+    -- * convert from bytestring and string+    , isHex+    , isHexString+    , fromHex+    , fromHexString+    , fromBinary+    , toBinary+    , toHex+    , toHexString+    -- * Misc function related to ref+    , refPrefix+    , cmpPrefix+    , toFilePathParts+    -- * Hash ByteString types to a ref+    , hash+    , hashLBS+    ) where  import Control.Monad (forM_) import qualified Crypto.Hash.SHA1 as SHA1@@ -31,16 +38,30 @@ import qualified Data.ByteString.Char8 as BC import Data.Bits import Data.Char (isHexDigit)+import Data.Data  import Foreign.Storable+import Control.Exception (Exception, throw)  -- | represent a git reference (SHA1) newtype Ref = Ref ByteString-        deriving (Eq,Ord)+        deriving (Eq,Ord,Data,Typeable)  instance Show Ref where         show = BC.unpack . toHex +-- | Invalid Reference exception raised when+-- using something that is not a ref as a ref.+data RefInvalid = RefInvalid ByteString+                deriving (Show,Eq,Data,Typeable)++-- | Reference wasn't found+data RefNotFound = RefNotFound Ref+                 deriving (Show,Eq,Data,Typeable)++instance Exception RefInvalid+instance Exception RefNotFound+ isHex = and . map isHexDigit . BC.unpack isHexString = and . map isHexDigit @@ -49,7 +70,7 @@ fromHex :: ByteString -> Ref fromHex s         | B.length s == 40 = Ref $ B.unsafeCreate 20 populateRef-        | otherwise        = error ("not a valid hex ref: " ++ show s)+        | otherwise        = throw $ RefInvalid s         where                  populateRef ptr = forM_ [0..19] $ \i -> do                         let v = (unhex (B.unsafeIndex s (i*2+0)) `shiftL` 4) .|. unhex (B.unsafeIndex s (i*2+1))@@ -77,7 +98,7 @@                 unhex 0x64 = 13                 unhex 0x65 = 14                 unhex 0x66 = 15 -- 'f'-                unhex _    = error "error fromHex: not a valid hex character"+                unhex _    = throw $ RefInvalid s  -- | take a hexadecimal string that represent a reference -- and turn into a ref@@ -106,7 +127,7 @@ fromBinary :: ByteString -> Ref fromBinary b         | B.length b == 20 = Ref b-        | otherwise        = error "not a valid binary ref"+        | otherwise        = throw $ RefInvalid b -- should hexify the ref here  -- | turn a reference into a binary bytestring toBinary :: Ref -> ByteString@@ -127,4 +148,5 @@ -- | hash a bytestring into a reference hash = Ref . SHA1.hash +-- | hash a lazy bytestring into a reference hashLBS = Ref . SHA1.hashlazy
Data/Git/Repository.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-} -- | -- Module      : Data.Git.Repository -- License     : BSD-style@@ -11,7 +12,9 @@         ( Git         , HTree         , HTreeEnt(..)+        , getCommitMaybe         , getCommit+        , getTreeMaybe         , getTree         , rewrite         , buildHTree@@ -24,9 +27,11 @@  import Control.Applicative ((<$>)) import Control.Monad+import Control.Exception (Exception, throw)  import Data.Maybe (fromMaybe) import Data.List (find)+import Data.Data  import Data.ByteString (ByteString) @@ -45,24 +50,35 @@ data HTreeEnt = TreeDir Ref HTree | TreeFile Ref type HTree = [(Int,ByteString,HTreeEnt)] +-- | Exception when trying to convert an object pointed by 'Ref' to+-- a type that is different+data InvalidType = InvalidType Ref ObjectType+                 deriving (Show,Eq,Data,Typeable)++instance Exception InvalidType+ -- should be a standard function that do that... mapJustM f (Just o) = f o mapJustM _ Nothing  = return Nothing  -- | get a specified commit-getCommit :: Git -> Ref -> IO (Maybe Commit)-getCommit git ref = getObject git ref True >>= mapJustM unwrap-        where-                unwrap (objectToCommit -> Just c@(Commit {})) = return $ Just c-                unwrap _                                      = return Nothing+getCommitMaybe :: Git -> Ref -> IO (Maybe Commit)+getCommitMaybe git ref = maybe Nothing objectToCommit <$> getObject git ref True +-- | get a specified commit but raises an exception if doesn't exists or type is not appropriate+getCommit :: Git -> Ref -> IO Commit+getCommit git ref = maybe err id . objectToCommit <$> getObject_ git ref True+    where err = throw $ InvalidType ref TypeCommit+ -- | get a specified tree-getTree :: Git -> Ref -> IO (Maybe Tree)-getTree git ref = getObject git ref True >>= mapJustM unwrap-        where-                unwrap (objectToTree -> Just c@(Tree {})) = return $ Just c-                unwrap _                                  = return Nothing+getTreeMaybe :: Git -> Ref -> IO (Maybe Tree)+getTreeMaybe git ref = maybe Nothing objectToTree <$> getObject git ref True +-- | get a specified tree but raise+getTree :: Git -> Ref -> IO Tree+getTree git ref = maybe err id . objectToTree <$> getObject_ git ref True+    where err = throw $ InvalidType ref TypeTree+ -- | try to resolve a string to a specific commit ref -- for example: HEAD, HEAD^, master~3, shortRef resolveRevision :: Git -> Revision -> IO (Maybe Ref)@@ -124,11 +140,7 @@               modf (RevModParentFirstN (n-1):xs) (head parentRefs)           modf (_:_) _ = error "unimplemented revision modifier" -          getParentRefs ref = do-              obj <- getCommit git ref-              case obj of-                  Just (Commit { commitParents = parents }) -> return parents-                  Nothing -> error "reference in commit chain doesn't exists"+          getParentRefs ref = commitParents <$> getCommit git ref  -- | returns a tree from a ref that might be either a commit, a tree or a tag. resolveTreeish :: Git -> Ref -> IO (Maybe Tree)@@ -162,8 +174,8 @@     resolveParents nbParent ref >>= process . reverse      where resolveParents :: Int -> Ref -> IO [ (Ref, Commit) ]-          resolveParents 0 ref = (:[]) . (,) ref . fromMaybe (error "commit cannot be found") <$> getCommit git ref-          resolveParents n ref = do commit <- fromMaybe (error "commit cannot be found") <$> getCommit git ref+          resolveParents 0 ref = (:[]) . (,) ref <$> getCommit git ref+          resolveParents n ref = do commit <- getCommit git ref                                     case commitParents commit of                                          [parentRef] -> liftM ((ref,commit) :) (resolveParents (n-1) parentRef)                                          _           -> return [(ref,commit)]@@ -185,13 +197,9 @@                 obj <- getObjectType git ref                 case obj of                         Just TypeBlob -> return (perm, ent, TreeFile ref)-                        Just TypeTree -> do-                                ctree <- getTree git ref-                                case ctree of-                                        Nothing -> error "unknown reference in tree object: no such child"-                                        Just t  -> do-                                                dir   <- buildHTree git t-                                                return (perm, ent, TreeDir ref dir)+                        Just TypeTree -> do ctree <- getTree git ref+                                            dir   <- buildHTree git ctree+                                            return (perm, ent, TreeDir ref dir)                         Just _        -> error "wrong type embedded in tree object"                         Nothing       -> error "unknown reference in tree object" @@ -200,23 +208,17 @@             -> Ref            -- ^ commit reference             -> [ByteString]   -- ^ paths             -> IO (Maybe Ref)-resolvePath git commitRef paths = do-        commit <- getCommit git commitRef-        case commit of-                Just (Commit { commitTreeish = tree }) -> resolve tree paths-                Nothing                    -> error ("not a valid commit ref: " ++ show commitRef)-        where+resolvePath git commitRef paths =+        getCommit git commitRef >>= \commit -> resolve (commitTreeish commit) paths+    where                 resolve :: Ref -> [ByteString] -> IO (Maybe Ref)                 resolve treeRef []     = return $ Just treeRef                 resolve treeRef (x:xs) = do-                        tree <- getTree git treeRef-                        case tree of-                                Just (Tree ents) -> do-                                        let cEnt = treeEntRef <$> findEnt x ents-                                        if xs == []-                                                then return cEnt-                                                else maybe (return Nothing) (\z -> resolve z xs) cEnt-                                Nothing          -> error ("not a valid tree ref: " ++ show treeRef)+                        (Tree ents) <- getTree git treeRef+                        let cEnt = treeEntRef <$> findEnt x ents+                        if xs == []+                            then return cEnt+                            else maybe (return Nothing) (\z -> resolve z xs) cEnt                  findEnt x = find (\(_, b, _) -> b == x)                 treeEntRef (_,_,r) = r
Data/Git/Revision.hs view
@@ -5,22 +5,27 @@ -- Stability   : experimental -- Portability : unix --+{-# LANGUAGE DeriveDataTypeable #-} module Data.Git.Revision-        ( Revision(..)-        , RevModifier(..)-        , fromString-        ) where+    ( Revision(..)+    , RevModifier(..)+    , RevisionNotFound(..)+    , fromString+    ) where  import Text.Parsec import Data.String+import Data.Data +-- | A modifier to a revision, which is+-- a function apply of a revision data RevModifier =           RevModParent Int       -- ^ parent accessor ^<n> and ^         | RevModParentFirstN Int -- ^ parent accessor ~<n>         | RevModAtType String    -- ^ @{type} accessor         | RevModAtDate String    -- ^ @{date} accessor         | RevModAtN Int          -- ^ @{n} accessor-        deriving (Eq)+        deriving (Eq,Data,Typeable)  instance Show RevModifier where     show (RevModParent 1)       = "^"@@ -30,8 +35,20 @@     show (RevModAtDate s)       = "@{" ++ s ++ "}"     show (RevModAtN s)          = "@{" ++ show s ++ "}" +-- | A git revision. this can be many things:+--    * a shorten ref+--    * a ref+--    * a named branch or tag+--  followed by optional modifiers 'RevModifier' that can represent:+--    * parenting+--    * type+--    * date data Revision = Revision String [RevModifier]-        deriving (Eq)+        deriving (Eq,Data,Typeable)++-- | Exception when a revision cannot be resolved to a reference+data RevisionNotFound = RevisionNotFound Revision+        deriving (Show,Eq,Data,Typeable)  instance Show Revision where     show (Revision s ms) = s ++ concatMap show ms
Data/Git/Storage.hs view
@@ -27,6 +27,7 @@     , getObjectRaw     , getObjectRawAt     , getObject+    , getObject_     , getObjectAt     , getObjectType     -- * setting objects@@ -303,6 +304,15 @@ getObject git ref resolveDelta = maybe Nothing toObj <$> getObjectRaw git ref resolveDelta         where                 toObj (ObjectInfo { oiHeader = (ty, _, extra), oiData = objData }) = packObjectFromRaw (ty, extra, objData)++-- | Just like 'getObject' but will raise a RefNotFound exception if the+-- reference cannot be found.+getObject_ :: Git       -- ^ repository+           -> Ref       -- ^ the object's reference to+           -> Bool      -- ^ whether to resolve deltas if found+           -> IO Object -- ^ returned object if found+getObject_ git ref resolveDelta = maybe (throwIO $ RefNotFound ref) return+                              =<< getObject git ref resolveDelta  -- | set an object in the store and returns the new ref -- this is always going to create a loose object.
Data/Git/Types.hs view
@@ -5,6 +5,7 @@ -- Stability   : experimental -- Portability : unix --+{-# LANGUAGE DeriveDataTypeable #-} module Data.Git.Types     (     -- * Type of types@@ -36,6 +37,7 @@ import Data.Git.Delta import Data.Time.Clock import Data.Time.Clock.POSIX+import Data.Data  -- | type of a git object. data ObjectType =@@ -45,7 +47,7 @@         | TypeTag         | TypeDeltaOff         | TypeDeltaRef-        deriving (Show,Eq)+        deriving (Show,Eq,Data,Typeable)  -- | Git time is number of seconds since unix epoch data GitTime = GitTime Integer Int
Hit/Hit.hs view
@@ -31,131 +31,128 @@ type HashTable k v = H.CuckooHashTable k v  instance Hashable.Hashable Ref where-	hash = Hashable.hash . toBinary+    hashWithSalt salt = Hashable.hashWithSalt salt . toBinary  verifyPack pref git = do-	offsets     <- H.new-	tree        <- H.new-	refs        <- newIORef M.empty-	entries     <- fromIntegral <$> packReadHeader (gitRepoPath git) pref-	leftParsed  <- newIORef entries-	-- enumerate all objects either directly in tree for fully formed objects-	-- or a list of delta to resolves -	packEnumerateObjects (gitRepoPath git) pref entries (setObj leftParsed refs offsets tree)-	readIORefAndReplace refs M.empty >>= dumpTree offsets tree-	where-		readIORefAndReplace ioref emptyVal = do-			v <- readIORef ioref-			writeIORef ioref emptyVal-			return v+    offsets     <- H.new+    tree        <- H.new+    refs        <- newIORef M.empty+    entries     <- fromIntegral <$> packReadHeader (gitRepoPath git) pref+    leftParsed  <- newIORef entries+    -- enumerate all objects either directly in tree for fully formed objects+    -- or a list of delta to resolves+    packEnumerateObjects (gitRepoPath git) pref entries (setObj leftParsed refs offsets tree)+    readIORefAndReplace refs M.empty >>= dumpTree offsets tree+    where+        readIORefAndReplace ioref emptyVal = do+            v <- readIORef ioref+            writeIORef ioref emptyVal+            return v -		setObj_ refs offsets tree (!info, objData)-			| objectTypeIsDelta (poiType info) = do-				(!ty, !ref, !ptr, !lenChain) <- do-					let loc = Packed pref (poiOffset info)-					objInfo <- maybe (error "cannot find delta chain") id <$> getObjectRawAt git loc True-					let (ty, sz, _) = oiHeader objInfo-					let !ref = objectHash ty sz (oiData objInfo)-					let ptr = head $ oiChains objInfo -- it's safe since deltas always have a non empty valid chain-					return (ty, ref, ptr, (length $ oiChains objInfo))-				H.insert tree ref (info { poiType = ty }, Just (ptr, lenChain))-			| otherwise = do-				let !ref = objectHash (poiType info) (poiActualSize info) objData-				modifyIORef refs (M.insert ref ())-				H.insert offsets (poiOffset info) ref-				H.insert tree ref (info,Nothing)+        setObj_ refs offsets tree (!info, objData)+            | objectTypeIsDelta (poiType info) = do+                (!ty, !ref, !ptr, !lenChain) <- do+                    let loc = Packed pref (poiOffset info)+                    objInfo <- maybe (error "cannot find delta chain") id <$> getObjectRawAt git loc True+                    let (ty, sz, _) = oiHeader objInfo+                    let !ref = objectHash ty sz (oiData objInfo)+                    let ptr = head $ oiChains objInfo -- it's safe since deltas always have a non empty valid chain+                    return (ty, ref, ptr, (length $ oiChains objInfo))+                H.insert tree ref (info { poiType = ty }, Just (ptr, lenChain))+            | otherwise = do+                let !ref = objectHash (poiType info) (poiActualSize info) objData+                modifyIORef refs (M.insert ref ())+                H.insert offsets (poiOffset info) ref+                H.insert tree ref (info,Nothing) -		setObj leftParsed refs offsets tree x = do-			parsed <- readIORef leftParsed-			when ((parsed `mod` 256) == 0) $ putStrLn (show parsed ++ " left to parse")-			modifyIORef leftParsed (\i -> i-1)-			setObj_ refs offsets tree x+        setObj leftParsed refs offsets tree x = do+            parsed <- readIORef leftParsed+            when ((parsed `mod` 256) == 0) $ putStrLn (show parsed ++ " left to parse")+            modifyIORef leftParsed (\i -> i-1)+            setObj_ refs offsets tree x -		dumpTree :: HashTable Word64 Ref -> HashTable Ref (PackedObjectInfo, Maybe (ObjectPtr, Int)) -> M.Map Ref () -> IO ()-		dumpTree offsets tree refs = do-			forM_ (M.toAscList refs) $ \(ref, ()) -> do-				ent <- fromJust <$> H.lookup tree ref-				printEnt offsets ref ent+        dumpTree :: HashTable Word64 Ref -> HashTable Ref (PackedObjectInfo, Maybe (ObjectPtr, Int)) -> M.Map Ref () -> IO ()+        dumpTree offsets tree refs = do+            forM_ (M.toAscList refs) $ \(ref, ()) -> do+                ent <- fromJust <$> H.lookup tree ref+                printEnt offsets ref ent -		-- print one line about the entry-		-- format is <sha1> <type> <real size> <size> <offset> [<number of chain element> <parent element>]-		printEnt _ ref (info,Nothing) = do-			printf "%s %-6s %d %d %d\n" (show ref)-			       (objectTypeMarshall $ poiType info)-			       (poiActualSize info)-			       (poiSize info)-			       (poiOffset info)+        -- print one line about the entry+        -- format is <sha1> <type> <real size> <size> <offset> [<number of chain element> <parent element>]+        printEnt _ ref (info,Nothing) = do+            printf "%s %-6s %d %d %d\n" (show ref)+                   (objectTypeMarshall $ poiType info)+                   (poiActualSize info)+                   (poiSize info)+                   (poiOffset info) -		printEnt offsets ref (info,Just (parentOffset, lenChain)) = do-			parentRef <- case parentOffset of-				PtrRef r -> return r-				PtrOfs off -> do-					let poff = poiOffset info - off-					maybe (error "cannot find delta's parent in pack ?") id <$> H.lookup offsets poff-			printf "%s %-6s %d %d %d %d %s\n" (show ref)-			       (objectTypeMarshall $ poiType info)-			       (poiActualSize info)-			       (poiSize info)-			       (poiOffset info)-			       (lenChain)-			       (show parentRef)+        printEnt offsets ref (info,Just (parentOffset, lenChain)) = do+            parentRef <- case parentOffset of+                PtrRef r -> return r+                PtrOfs off -> do+                    let poff = poiOffset info - off+                    maybe (error "cannot find delta's parent in pack ?") id <$> H.lookup offsets poff+            printf "%s %-6s %d %d %d %d %s\n" (show ref)+                   (objectTypeMarshall $ poiType info)+                   (poiActualSize info)+                   (poiSize info)+                   (poiOffset info)+                   (lenChain)+                   (show parentRef)   catFile ty ref git = do-	let expectedType = case ty of-		"commit" -> Just TypeCommit-		"blob"   -> Just TypeBlob-		"tag"    -> Just TypeTag-		"tree"   -> Just TypeTree-		"-t"     -> Nothing-		_        -> error "unknown type request"-	mobj <- getObjectRaw git ref True-	case mobj of-		Nothing  -> error "not a valid object"-		Just obj ->-			let (objty, _, _) = oiHeader obj in-			case expectedType of-				Nothing  -> putStrLn $ objectTypeMarshall objty-				Just ety -> do-					when (ety /= objty) $ error "not expected type"-					LC.putStrLn (oiData obj)+    let expectedType = case ty of+                        "commit" -> Just TypeCommit+                        "blob"   -> Just TypeBlob+                        "tag"    -> Just TypeTag+                        "tree"   -> Just TypeTree+                        "-t"     -> Nothing+                        _        -> error "unknown type request"+    mobj <- getObjectRaw git ref True+    case mobj of+        Nothing  -> error "not a valid object"+        Just obj ->+            let (objty, _, _) = oiHeader obj in+            case expectedType of+                Nothing  -> putStrLn $ objectTypeMarshall objty+                Just ety -> do+                    when (ety /= objty) $ error "not expected type"+                    LC.putStrLn (oiData obj)  lsTree revision _ git = do-	ref <- maybe (error "revision cannot be found") id <$> resolveRevision git revision-	tree <- resolveTreeish git ref-	case tree of-		Just t -> do-			htree <- buildHTree git t-			mapM_ (showTreeEnt) htree -		_      -> error "cannot build a tree from this reference"-	where-		showTreeEnt (p,n,TreeDir r _) = printf "%06o tree %s    %s\n" p (show r) (BC.unpack n)-		showTreeEnt (p,n,TreeFile r)  = printf "%06o blob %s    %s\n" p (show r) (BC.unpack n)+    ref <- maybe (error "revision cannot be found") id <$> resolveRevision git revision+    tree <- resolveTreeish git ref+    case tree of+        Just t -> do+            htree <- buildHTree git t+            mapM_ (showTreeEnt) htree+        _      -> error "cannot build a tree from this reference"+    where+        showTreeEnt (p,n,TreeDir r _) = printf "%06o tree %s    %s\n" p (show r) (BC.unpack n)+        showTreeEnt (p,n,TreeFile r)  = printf "%06o blob %s    %s\n" p (show r) (BC.unpack n)  revList revision git = do-	ref <- maybe (error "revision cannot be found") id <$> resolveRevision git revision-	loopTillEmpty ref-	where loopTillEmpty ref = do-		obj <- getCommit git ref-		case obj of-			Just (Commit { commitParents = parents }) -> do-				putStrLn $ show ref-				-- this behave like rev-list --first-parent.-				-- otherwise the parents need to be organized and printed-				-- in a reverse chronological fashion.-				case parents of-					[]    -> return ()-					(p:_) -> loopTillEmpty p-			Nothing -> error ("commit reference " ++ show ref ++ " in commit chain doesn't exists")+    ref <- maybe (error "revision cannot be found") id <$> resolveRevision git revision+    loopTillEmpty ref+    where loopTillEmpty ref = do+                commit <- getCommit git ref+                putStrLn $ show ref+                -- this behave like rev-list --first-parent.+                -- otherwise the parents need to be organized and printed+                -- in a reverse chronological fashion.+                case commitParents commit of+                    []    -> return ()+                    (p:_) -> loopTillEmpty p  main = do-	args <- getArgs-	case args of-		["verify-pack",ref]  -> withCurrentRepo $ verifyPack (fromHexString ref)-		["cat-file",ty,ref]  -> withCurrentRepo $ catFile ty (fromHexString ref)-		["ls-tree",rev]      -> withCurrentRepo $ lsTree (fromString rev) ""-		["ls-tree",rev,path] -> withCurrentRepo $ lsTree (fromString rev) path-		["rev-list",rev]     -> withCurrentRepo $ revList (fromString rev)-		cmd : [] -> error ("unknown command: " ++ cmd)-		[]       -> error "no args"-		_        -> error "unknown command line arguments"+    args <- getArgs+    case args of+        ["verify-pack",ref]  -> withCurrentRepo $ verifyPack (fromHexString ref)+        ["cat-file",ty,ref]  -> withCurrentRepo $ catFile ty (fromHexString ref)+        ["ls-tree",rev]      -> withCurrentRepo $ lsTree (fromString rev) ""+        ["ls-tree",rev,path] -> withCurrentRepo $ lsTree (fromString rev) path+        ["rev-list",rev]     -> withCurrentRepo $ revList (fromString rev)+        cmd : [] -> error ("unknown command: " ++ cmd)+        []       -> error "no args"+        _        -> error "unknown command line arguments"
Tests/Tests.hs view
@@ -29,6 +29,7 @@ arbitraryBS size = B.pack . map fromIntegral <$> replicateM size (choose (0,255) :: Gen Int) arbitraryBSno0 size = B.pack . map fromIntegral <$> replicateM size (choose (1,255) :: Gen Int) +arbitraryBSasciiNoSpace size = B.pack . map fromIntegral <$> replicateM size (choose (0x21,0x7f) :: Gen Int) arbitraryBSascii size = B.pack . map fromIntegral <$> replicateM size (choose (0x20,0x7f) :: Gen Int) arbitraryBSnoangle size = B.pack . map fromIntegral <$> replicateM size (choose (0x40,0x7f) :: Gen Int) @@ -72,7 +73,7 @@     arbitrary = Commit <$> arbitrary <*> arbitraryRefList <*> arbitraryName <*> arbitraryName <*> return Nothing <*> arbitrarySmallList <*> arbitraryMsg  instance Arbitrary CommitExtra where-    arbitrary = CommitExtra <$> arbitraryBSascii 80 <*> arbitraryMsg+    arbitrary = CommitExtra <$> arbitraryBSasciiNoSpace 80 <*> arbitraryMsg  instance Arbitrary Tree where     arbitrary = Tree <$> arbitraryEnts
hit.cabal view
@@ -1,5 +1,5 @@ Name:                hit-Version:             0.4.3+Version:             0.5.0 Synopsis:            Git operations in haskell Description:     .@@ -77,7 +77,7 @@     Build-depends:   base >= 4 && < 5                    , mtl                    , containers-                   , hashable+                   , hashable >= 1.2                    , hashtables                    , bytestring                    , attoparsec >= 0.10.1