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 +41/−19
- Data/Git/Repository.hs +40/−38
- Data/Git/Revision.hs +23/−6
- Data/Git/Storage.hs +10/−0
- Data/Git/Types.hs +3/−1
- Hit/Hit.hs +109/−112
- Tests/Tests.hs +2/−1
- hit.cabal +2/−2
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